--- title: "Régression avec R" toc: true author: "Simon Dufour" date: 2022-01-01 categories: ["R", "Statistics"] tags: ["R", "Statistics"] ---

This document is in French. En français! C'est une partie de mon cours avancé d'épidémiologie (PTM6675). J'y décris les procédures de bases dans R pour réaliser les régressions linéaires et logistiques, les régressions pour les données de compte et d'incidence, ainsi que les analyses de survie. Une partie sur les modèles mixtes est en construction.

{{< figure src="Ordi.jpg" >}}

1 À propos

Dans ce document, vous trouverez les différentes manières d’utiliser R pour vos analyses statistiques de base. Notez que les notions théoriques relatives aux tests statistiques utilisés n’y sont pas présentées. Pour cela, vous pouvez vous référrer au livre Veterinary Epidemiologic Research (Dohoo et al., 2009) ou au cours PTM-6675. Dans ce document, nous supposons que vous savez déjà:
- Importer ou créer des bases de données dans R
- Modifier des variables ou sélectionner une partie d’un jeu de données
- Produire des tables de fréquence
- Produire des figures de base avec le package ggplot2

Nous supposons que vous avez quelques connaissances de base de R. Si vous n’avez jamais travaillé avec R auparavant ou si vous vous sentez un peu rouillé, voici quelques ressources pour vous aider à vous préparer :

N’oubliez pas qu’il existe souvent de nombreuses façons différentes de réaliser un travail donné dans R. Dans ce document, nous avons essayé de nous en tenir aux approches les plus simples (par exemple, le code le plus court, le nombre minimal de bibliothèques R).

Dans ce document, nous couvrirons quelques généralités sur la gestion de projets d’analyses, puis sur les fonctions de bases qui vous permettrons de réaliser vos projets de:
- Régression linéaire;
- Régression logistique;
- Régression pour des données de comptes ou d’incidence;
- Analyse de survie;
- Modèles mixtes pour données structurées (les fameux modèles avec intercepts et/ou pentes aléatoires).

Tout au long du texte, vous trouverez des exemples de code R agrémentés de commentaires. Le code R utilisé se trouve dans les encadrés en gris (comme l’exemple qui suit). C’est le code que vous pourrez utiliser pour vos propres analyses. Les lignes précédées du signe # sont un commentaire, elles ne sont pas considérées lorsque R les lit. Après chaque encadré gris, suivra un encadré blanc où les résultats de l’analyse sont présentées. N’oubliez pas, R est sensible aux majuscules. Par exemple, voici un code R où je demande simplement de présenter les statistiques principales des variables du jeu de données cars. Ce jeu de données contient 2 variables, speed et dist:

#Ceci est un commentaire. R ignorera cette ligne
#La fonction summary() produit les principales statistiques pour un jeu de données
summary(cars)
##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00
#On peut aussi, par exemple demander les statistique d'une variable précise dans un jeu  de données de cette façon:
summary(cars$speed)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     4.0    12.0    15.0    15.4    19.0    25.0

Tout au long du document, dans le texte, j’utiliserai:
- L’italique pour les ensembles de données ou les variables. Par exemple, la variable speed de l’ensemble de données cars.
- Les cases grisées pour les bibliothèques R (par exemple, episensr) et les fonctions (par exemple, summary()).

Dans R, nous pouvons d’abord appeler une bibliothèque donnée et ensuite utiliser les fonctions liées à chaque bibliothèque ou nous pouvons nommer la bibliothèque suivie de :: et ensuite la fonction. Par exemple, les deux morceaux de code suivants sont équivalents :

library(ggplot2)
ggplot(data=cars, mapping=(aes(x=speed)))+
  geom_histogram()

##OR##

ggplot2::ggplot(data=cars, mapping=(aes(x=speed)))+
  geom_histogram()

Cette dernière solution peut améliorer la reproductibilité, mais au prix de scripts plus longs. Dans tout le document, nous appellerons toujours d’abord la bibliothèque puis nous exécuterons les fonctions afin de garder des codes plus courts.

Une dernière chose, lors de l’utilisation d’une fonction donnée, il n’est pas obligatoire de nommer tous les arguments, du moment qu’ils sont présentés dans l’ordre attendu par cette fonction. Par exemple, la fonction ggplot() que nous avons utilisée dans le morceau de code précédent s’attend à voir d’abord un jeu de données (data=), puis un attribut de cartographie (mapping=) et, dans cet attribut de cartographie, une variable x (x=). Nous pourrions raccourcir le code en omettant tous ces éléments. Les deux morceaux de code suivants sont donc équivalents :

library(ggplot2)
ggplot(data=cars, mapping=(aes(x=speed)))+
  geom_histogram()

##OR##  

library(ggplot2)
ggplot(cars, (aes(speed)))+
  geom_histogram()

Tout au long de ce document, cependant, nous utiliserons le script le plus long, avec tous les arguments nommés. Étant donné que vous êtes en train d’apprendre ces nouvelles fonctions, il serait assez difficile d’utiliser le script le plus court dès le début. Mais vous pourrez certainement adopter les scripts les plus courts plus tard.

COMMENÇONS!

2 Bonnes pratiques de gestion de projet

La réplication des résultats de recherche par des investigateurs indépendants est un des éléments fondamentaux dans l’accumulation de preuves scientifiques. Mais les recherches actuellement menées utilisent fréquemment des méthodes avancées d’analyses et des bases de données de plus en plus grandes et complexes. Un standard minimum à atteindre devrait donc être d’au moins de pouvoir reproduire ses propres résultats de recherche (Peng et al., 2006).1. Nous allons donc nous attarder ici à quelques notes générales sur des pratiques personnelles à mettre en place pour vous assurer de pouvoir répondre positivement à cette question : suis-je capable dans 2 semaines, 2 mois, 2 ans, de reproduire les mêmes résultats qu’aujourd’hui ? Cette question pourrait tout aussi bien être formulée de cette manière : quelqu’un qui ne connaît pas ou peu mon projet (par exemple mon directeur de recherche!) peut-il, à partir de mes dossiers, comprendre clairement ce que j’ai fait et pourquoi ? Ces notes sont inspirées des travaux de Noble, Sandve et Wilson (Noble, 2009.2 ; Sandve et al., 2013.3; Wilson et al., 2014.4) et ne constituent en rien des règles à impérativement mettre en place, mais plutôt des inspirations à mettre en pratique selon sa méthode de travail personnelle. Notez aussi que la « reproductibilité » vous permettra de travailler plus efficacement. Par exemple, pour apporter des corrections aux analyses initialement effectuées suite aux commentaires d’un réviseur ou encore, afin de réutiliser les scripts (i.e., les codes R) préalablement utilisés sur de nouvelles données dans de nouveaux travaux de recherche.

2.1 Organiser son projet de recherche

Tous les fichiers pertinents à un projet devraient se trouver dans le même répertoire. La figure 1 est un exemple de structure de répertoire pour un projet. En utilisant toujours la même structure de répertoire d’un projet à l’autre vous vous éviterez bien des recherches de documents d’un projet à l’autre.

Figure 2.1. Exemple de structure de répertoire.

2.2 Où sauvegarder son projet

La tentation peut être grande (surtout si vous êtes sous Windows) de sauvegarder ses documents sur le bureau. Ce n’est pas une bonne idée :
- Si vous êtes en réseau et que votre institution fait des sauvegardes automatiques de vos fichiers, ce qui est mis sur le bureau n’est généralement pas inclus;
- Vos fichiers sont à la vue de tous ceux qui passent près de votre ordinateur;
- Sous Windows, les fichiers sauvegardés sur le bureau sont inclus dans votre profil d’utilisateur, ce qui augmente sa taille et peut diminuer les performances de l’ordinateur;
- Si votre ordinateur Windows a un gros problème et doit être restauré par la fonction system restore de Windows, cette fonction n’inclut pas les documents sauvegardés sur le bureau. Vous perdrez donc votre travail;

Il faut penser à bien choisir les noms de ses répertoires et fichiers. En effet ces noms feront partie du chemin à écrire dans vos scripts d’analyse. Un chemin court est donc préférable, p.ex.

C: projet

Remarquez que si vous tenez absolument à avoir accès à votre fichier via le bureau, vous pouvez toujours y placer un raccourci (c’est fait pour ça!).

2.3 Où sauvegarder ses données

Les différentes bases de données d’un projet devraient se trouver toutes sous le même répertoire, accompagnées de méta-données. Ces méta-données permettent de décrire vos bases de données : d’où viennent-elles, leurs structures, quelles sont les variables, la légende, etc. Un simple fichier texte suffit (voir figure 1), avec un nom évocateur. Par exemple, un document README.txt pourrait décrire les différentes bases de données et des documents keyTableX.txt pourront contenir la légende pour chacune des différentes bases de données. Pensez aussi à donner à vos bases de données des noms courts et datés: Phase1_12-01-2021.csv plutôt que Données pour Jean_version3-révision _transfer_final_revue_final2.xlsx (c’est un exemple véridique d’un de mes premiers projets!). Les éléments nécessaires à l’identification des bases de données seront, de toutes façons, expliqués dans votre document README.txt. Finalement, bien que la protection de la langue française soit un objectif louable, gardez en tête que vous aurez possiblement à partager plusieurs de ces documents et bases de données avec des collaborateurs internationaux. Des noms de fichiers, de variables et des documents en anglais pourront possiblement vous épargner plusieurs heures de traduction dans le futur.

2.4 Scripts d’analyse

Toutes les étapes de vos analyses devraient être réalisées à partir de scripts (e.g. vos codes R): laisser faire le travail par l’ordinateur et sauvegarder les commandes qui lui sont données pour pouvoir les réutiliser plus tard. Même les données ne doivent pas être modifiées manuellement. C’est non seulement inefficace, mais source d’erreurs et (presque) impossible à reproduire. Assurez-vous d’avoir une base de données initiale bien nettoyée, par la suite, si vous devez exclure/corriger certaines observations pour une analyse donnée, faites-le dans le script de cette analyse. Votre script doit permettre d’avoir accès aux données et, idéalement, pour ce faire utiliser des chemins relatifs (notez que nous proposerons une alternative à cela, les Projets R dans la prochaine section). Votre script d’analyse doit être compréhensible pour un « humain » : court, standardisé quant au style, format et noms des variables ou fonctions utilisées, et comprenant des commentaires. Essayer de diviser les tâches entre plusieurs scripts : un pour la manipulation des données, un pour les analyses descriptives, un pour les modélisations etc.

Notez que ces différents scripts (manipulation des données, analyses descriptives, modélisations, production de figures etc.) forment ensemble une chaîne, une combinaison: un workflow. Si vous faite des modifications à votre script qui vous permettait d’organiser la table de données, par exemple pour ajouter une nouvelle variable à votre table (e.g. vous venez finalement de recevoir vos résultats de PCR), vous devrez possiblement mettre à jour votre script d’analyses descriptives et l’exécuter, idem pour vos scripts de modélisation, etc.

2.5 Les projets R

RStudio permet de créer un type de fichier qui s’appelle un Projet R. Pour créer un Projet R, suivez ces instructions simples Using RStudio Projects. Après avoir créé un Projet R dans un fichier donné sur votre ordinateur, vous pouvez copier dans ce fichier (ou un sous-fichier de celui-ci) les bases de données qui serviront dans ce projet. C’est aussi dans ce fichier que les scripts d’analyses que vous développerez seront enregistrés. Finalement, vous pourriez aussi y enregistrer des résultats de vos analyses, par exemple des figures. Finalement vous y trouverez un élément avec une extension .Rproj. Si vous cliquez sur cet élément, RStudio s’ouvrira sur les scripts que vous utilisiez au moment où vous aviez suspendu vos analyses.

L’avantage d’un Projet R est que tous les chemins d’accès (par exemple pour importer un jeu de données) seront maintenant relatifs au Projet R et non à l’endroit, sur votre ordinateur, où le Projet R est lui-même hébergé. Ce n’est pas très clair, n’est-ce pas?

Allons-y d’un exemple. Disons que vous n’utilisez pas un Projet R. Dans un script d’analyse, lorsque vous voudrez importer un jeu de données, vous devrez indiquer le chemin d’accès pour ce jeu de données, par exemple: C:/Users/dufours/OneDrive - Universite de Montreal/Enseignement UdM/Cours/PTM 6675-Epi 2/Datadaisy2.csv. Évidemment, si vous donnez ce script d’analyse et le jeu de données à un collègue (ou si vous déplacez vos dossiers vers un nouvel ordinateur) les scripts ne fonctionneront plus, puisque les chemins d’accès seront maintenant erronés.

Maintenant, si vous avez plutôt créé un Projet R et que, dans ce fichier vous avez créé un sous-fichier Data dans lequel vous avez déposé les jeux de données dont vous aurez besoin dans ce projet. Dans vos scripts, le chemin d’accès pour ce jeu de données deviendra simplement Data/Datadaisy2.csv. Vous pouvez maintenant transférer en bloc vers un autre ordinateur le fichier qui contient votre Projet R avec vos scripts d’analyses, les jeux de données, etc. Tous vos scripts seront fonctionnels. On dira que vos analyses sont maintenant portables.

2.6 Copies de sécurité

Le pire peut arriver et vous perdez toutes vos données! Avant qu’il ne soit trop tard, pensez à mettre en place une stratégie de sauvegarde de vos fichiers. Il n’y a pas de stratégie universelle, mais chacun doit trouver celle qui lui convient. Deux règles cependant :

1) Des copies à jour
2) Séparer physiquement les sauvegardes.

Vos sauvegardes doivent être régulières et entreposées dans un lieu physique différent de vos données originelles. L’idéal est d’avoir deux systèmes de sauvegarde (e.g. sur un nuage numérique et sur votre PC). Vous pouvez sauvegarder vos données sur un « nuage », tels que Dropbox, Google Drive, etc. Ces services ont cependant des licences et des obligations légales pouvant exposer vos données à des risques juridiques et compromettre la confidentialité de vos données. Tous les services cités ci-dessus sont opérés sur des serveurs aux USA. Les universités canadiennes sont soumises à la Loi sur l’accès à l’information et à la Loi sur la protection des renseignements personnels qui restreint la possibilité de déposer des données personnelles sur des serveurs à l’extérieur du pays. Renseignez-vous auprès de votre institution pour savoir quelles sont les meilleures possibilités pour vous. Présentement, l’Université de Montréal supporte l’utilisation de Onedrive par ses professeurs et étudiants. Scholars portal est un autre exemple de service disponible pour les membres académiques et étudiants de l’Université de Montréal, permettant de créer un dépôt de données pour leur recherche.

3 Obtention des données pour les travaux pratiques

Les données utilisées pour les TP sont obtenues à partir du site web du livre Veterinary Epidemiologic Research (Dohoo et al., 2009). Choisissez: ZIP file of all datasets – Excel format. Une fois téléchargés sur votre ordinateur et décompressés, les tableaux de données en format xlsx sont disponibles avec l’appel suivant (remplacer le chemin d’accès avec le chemin approprié vers votre répertoire ou copiez-les dans un Projet R que vous aurez créé):

#Importation de la table Daisy2.xlsx 
#Vous pouvez importer en format XLSX comme suit:
#library(readxl) #Ouvrir le package qui lit les fichiers excel
#daisy2 <- read_excel("C:/Users/dufours/Documents/DiskD/Enseignement UdM/Cours/PTM 6675-Epi 2/Labo R/Data/ver2_data_excel/Daisy2.xlsx") #Indiquez votre chemin d'accès. Notez  les 'forward slash' plutôt que les 'backslash'

#Ou en format CSV
daisy2 <-read.csv(file="daisy2.csv", header=TRUE, sep=",")
#Pour voir les premières 6 lignes d'un jeu de données (afin de mieux comprendre sa structure):
head(daisy2)
##   region herd cow study_lact herd_size mwp parity milk120    calv_dt cf fs cc
## 1      1    1   1          1       294  26      5  3505.8 1996-11-11 80 NA NA
## 2      1    1   2          1       294  26      5  3691.3 1997-01-12 64 NA NA
## 3      1    1   3          1       294  26      5  4173.0 1997-01-17 71  0 93
## 4      1    1   4          1       294  26      5  3727.3 1997-02-11 35  1 35
## 5      1    1   5          1       294  26      5  3090.8 1997-06-26 47  0 87
## 6      1    1   6          1       294  26      4  5041.2 1996-10-16 NA NA NA
##   wpc spc twin dyst rp vag_disch h7
## 1  NA   6    0    0  0         0  1
## 2  NA   3    0    0  0         0  1
## 3  67   2    0    0  0         0  1
## 4   9   1    0    0  0         0  1
## 5  61   2    0    0  0         0  1
## 6  NA  NA    0    0  1         0  1

4 Aide de R

Si vous avez besoin d’aide concernant une fonction particulière, par exemple la fonction [lm] pour les modèles linéaires, il y a évidemment beaucoup de matériel sur l’internet, mais vous trouverez aussi du contenu dans la section d’aide de RStudio.

Figure 4.1. Section aide de RStudio.

5 R Markdown

À l’aide de R Markdown il est possible d’envoyer les résultats de vos analyses directement dans un document Microsoft Word, PDF, HTML, etc. Vous pourrez ainsi produire un texte avec des tables et des figures. Certains éléments de ce texte peuvent même être des résultats de vos analyses. Ces notes de cours, par exemple, ont été préparées à l’aide de R Markdown. Par exemple, si je demande:

a<- summary(cars$speed)

Je peux ensuite vous indiquer dans le texte que la vitesse médiane dans le jeu de données était 15 km/h. Dans la phrase précédente le 15 est un objet R, c’est le 3ième élément du vecteur que j’ai nommé a et je l’ai inclus dans mon texte en l’appelant (i.e., j’ai invoqué a[3] dans mon code R Markdown comme ceci: “…le jeu de données était tickmark r a[3] tickmark km/h. Dans la…”).
Vous pourrez aussi inclure une table dans votre texte:

Table 5.1. Une table produite avec la fonction knitr.
mpg cyl disp hp drat wt qsec vs am gear carb
Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2

Ou une figure:

**Figure 5.1.** Une figure produite avec la librairie ggplot2.

Figure 5.1. Une figure produite avec la librairie ggplot2.

R Markdown pourrait donc être très utile dans le futur pour produire vos rapports d’analyses ou même les textes de vos articles. Ceux-ci seront automatiquement mis-à-jour lorsque vous modifierez vos analyses.

6 Régression linéaire

6.1 Généralités

La fonction de base dans R pour la régression linéaire est la fonction lm(). Pour les exemples suivants, nous allons utiliser que les troupeaux du jeu de données Daisy2.xlsx avec h7=1.

daisy2 <-read.csv(file="daisy2.csv", header=TRUE, sep=",")
daisy2_mod<-subset(daisy2, h7==1)

Une régression linéaire dans sa plus simple expression pourrait être:

modele<-lm(data=daisy2_mod, milk120 ~ (parity+twin)) #J'ai créé un nouvel objet qui s'appelle modele et qui est une régression des variables parity et twin sur milk120
modele #Je demande à voir l'objet modele
## 
## Call:
## lm(formula = milk120 ~ (parity + twin), data = daisy2_mod)
## 
## Coefficients:
## (Intercept)       parity         twin  
##      2734.9        172.5       -150.6

Les résultats présentés sont simplement l’intercept et les coefficients de parity et de twin. Pour une vache avec parity=0 et twin=0 le modèle prédit 2734,9kg de lait en 120 jours. On ajoute 172,5kg pour chaque augmentation de 1 unité de parity et on enlève 150,6kg lorsque twin est présent. Si vous préférez:

\[ milk120 = 2734,9 + 172,5*parity - 150,6*twin \]

Pour avoir un peu plus d’informations sur ce modèle, vous pouvez demander:

summary(modele) #Je demande un résumé de l'objet modele
## 
## Call:
## lm(formula = milk120 ~ (parity + twin), data = daisy2_mod)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1969.69  -434.13    -7.12   422.23  2147.50 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2734.865     32.313   84.64   <2e-16 ***
## parity       172.513      9.923   17.39   <2e-16 ***
## twin        -150.557    101.741   -1.48    0.139    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 650.3 on 1765 degrees of freedom
##   (208 observations deleted due to missingness)
## Multiple R-squared:  0.1463, Adjusted R-squared:  0.1453 
## F-statistic: 151.2 on 2 and 1765 DF,  p-value: < 2.2e-16

Quelques infos sont alors présentées sur:
- Les résiduels (par exemple, le min et le max).
- Votre modèle, mais cette fois avec les erreurs-types de chacun des coefficients et les valeurs de P pour le test de T de chaque coefficient.
- L’erreur-type des résiduels est également rapportée (650.3) de même que les degrés de liberté (1765) et le nombre d’observations manquantes (208).
- Le \(R^2\) (le coefficient de détermination) est présenté. Dans ce cas 14.63% de la variation de milk120 est expliquée par le modèle.
- La valeur de F (151.2) qui teste si tous les coefficients=0 est aussi rapportée, de même que ses degrés de libertés (2 et 1765) et la valeur de P associée (P<0.01).

Vous pouvez demander à voir la table ANOVA à l’aide de la fonction aov().

aov<-aov(modele) #Je créer un objet aov
summary(aov) #Je demande de résumer cet objet aov
##               Df    Sum Sq   Mean Sq F value Pr(>F)    
## parity         1 126939726 126939726  300.21 <2e-16 ***
## twin           1    925932    925932    2.19  0.139    
## Residuals   1765 746306281    422836                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 208 observations deleted due to missingness

Finalement, notez que parity a été traitée comme une variable quantitative. Si vous désirez qu’elle soit traitée comme une variable catégorique, vous pourriez soit créer une nouvelle variable catégorique et l’utiliser dans le modele.

daisy2_mod$par_cat<-factor(daisy2_mod$parity)

Soit l’écrire directement dans le modele.

modele1<-lm(data=daisy2_mod, milk120 ~ (factor(parity)+twin)) #Factor() me permet d'indiquer qu'une variable est catégorique
modele1 
## 
## Call:
## lm(formula = milk120 ~ (factor(parity) + twin), data = daisy2_mod)
## 
## Coefficients:
##     (Intercept)  factor(parity)2  factor(parity)3  factor(parity)4  
##          2630.9            719.3            798.9            836.2  
## factor(parity)5  factor(parity)6  factor(parity)7             twin  
##           818.8            937.6            793.9           -192.3

Il y aura maintenant un coefficient pour chaque niveau de la variable parity sauf le niveau de référence (parity=1 a été choisi comme référence ici).

6.2 Ajouter des intervalles de confiance

Des IC95% pour chacun des paramètres estimés seront obtenus comme suit à l’aide de la fonction confint():

confint(modele, level= 0.95)
##                 2.5 %    97.5 %
## (Intercept) 2671.4897 2798.2413
## parity       153.0500  191.9752
## twin        -350.1027   48.9892

6.3 Test de F pour comparer modèles complet vs. réduit

Tester si quelques coefficients spécifiques sont différents de zéro (i.e., comparer un modèle complet et un modèle réduit) est très simple dans R. Il faut d’abbord faire rouler chaque modèle. Par exemple, dans le modèle suivant, pour tester les 4 problèmes de reproduction (twin, dyst, rp et vag_disch) ensemble, vous devrez exécuter les 2 modèles suivants

modele_complet <- lm(data=daisy2_mod, milk120 ~ (parity+twin+dyst+rp+vag_disch))
modele_reduit <- lm(data=daisy2_mod, milk120 ~ (parity))

Ensuite, ont peut utiliser la fonction anova() pour comparer les modèles.

anova(modele_complet, modele_reduit)
## Analysis of Variance Table
## 
## Model 1: milk120 ~ (parity + twin + dyst + rp + vag_disch)
## Model 2: milk120 ~ (parity)
##   Res.Df       RSS Df Sum of Sq      F Pr(>F)
## 1   1762 744046844                           
## 2   1766 747232213 -4  -3185369 1.8858 0.1103

Dans ce cas, on obtient une valeur de P de 0.11. Donc, le modèle complet n’est pas meilleur ou, si vous préférez, les coefficients de twin, dyst, rp et vag_disch ne sont pas différents de zéro.

6.4 Transformer une variable

Pour transformer une variable (e.g. centrer, mettre à l’échelle, mettre au carré ou au cube), vous pouvez simplement utiliser les notions de base pour créer une nouvelle variable dans votre jeu de données. Vous pourrez ensuite utiliser cette nouvelle variable dans votre modèle. Par exemple, le code suivant permet de créer 3 nouvelles variables.

daisy2_mod$parity_ct<-daisy2_mod$parity-1 
daisy2_mod$herd_size_ct_sc <-(daisy2_mod$herd_size-250)/100
daisy2_mod$herd_size_sq <-daisy2_mod$herd_size_ct_sc*daisy2_mod$herd_size_ct_sc
  • Une variable parity centrée sur la valeur 1 (i.e., le 1 devient le zéro pour cette nouvelle variable);
  • Une nouvelle variable herd_size_ct_sc centrée sur 250 vaches et mise à l’échelle pour représenter une augmentation de 100 vaches;
  • Une nouvelle variable herd_size_sq qui est la variable herd_size centrée, mise à l’échelle et élevé au carré (i.e. un terme polynomial qui pourra être utilisé afin de vérifier la linéarité de la relation entre herd_size et votre variable dépendante).

6.5 Choisir la valeur de référence pour une variable catégorique

Notez que pour les variables catégoriques, R décide (et pas toujours bien) de la valeur de référence. On peut tout de même forcer la valeur de référence qui nous intéresse. Dans le code suivant, j’ai indiqué en utilisant la fonction relevel() que, pour la variable par_cat créée précédemment, la valeur 2 sera la catégorie de référence. Lorsque j’utilise ensuite cette variable dans un modèle statistique, la valeur 2 est automatiquement utilisée comme référence.

daisy2_mod<-within(daisy2_mod, par_cat<-relevel(par_cat, ref=2)) #Sélection de la valeur de référence par_cat=2
modele2<-lm(data=daisy2_mod, milk120 ~ (par_cat+twin))
summary(modele2)
## 
## Call:
## lm(formula = milk120 ~ (par_cat + twin), data = daisy2_mod)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2240.03  -382.80     3.92   373.68  2180.58 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3350.23      30.80 108.777  < 2e-16 ***
## par_cat1     -719.28      42.46 -16.938  < 2e-16 ***
## par_cat3       79.60      44.96   1.771  0.07681 .  
## par_cat4      116.96      49.33   2.371  0.01785 *  
## par_cat5       99.49      51.56   1.930  0.05382 .  
## par_cat6      218.27      67.51   3.233  0.00125 ** 
## par_cat7       74.66     218.88   0.341  0.73308    
## twin         -192.25      96.06  -2.001  0.04550 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 612.9 on 1760 degrees of freedom
##   (208 observations deleted due to missingness)
## Multiple R-squared:  0.2436, Adjusted R-squared:  0.2406 
## F-statistic: 80.98 on 7 and 1760 DF,  p-value: < 2.2e-16

6.6 Comparer les niveaux d’un prédicteur catégorique avec >2 catégories

Pour un prédicteur catégorique avec plus de 2 catégories, on voudra d’abord savoir si le prédicteur est significativement associé à la variable dépendante (i.e. test de F). Si c’est le cas, on voudra alors comparer les niveaux entre eux (i.e. tests de T). Deux problèmes se posent alors :
1) Problème de comparaisons multiples; on voudra ajuster nos valeurs de P ou nos IC 95% en fonction du nombre de comparaison effectuées.
2) La table avec les coefficients de régression nous rapporte le test de T pour chaque coefficient lorsque comparé au niveau de référence, mais pas entre eux.
Par exemple, avec une variable parity_cat avec 3 catégories : 1=parité 1, 2=parité 2 et 3=parité ≥ 3, on aura

#Je créé une variable parity catégorique:
daisy2_mod$par_cat <- cut(daisy2_mod$parity, breaks = c(0, 1, 2, Inf),
                  labels = c("First", "Second", "Third or more"))
#Ma régression
modele<-lm(data=daisy2_mod, milk120 ~ (par_cat))
summary(modele)
## 
## Call:
## lm(formula = milk120 ~ (par_cat), data = daisy2_mod)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2234.73  -387.55     7.79   377.11  2176.01 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           2629.63      29.31   89.71   <2e-16 ***
## par_catSecond          715.30      42.45   16.85   <2e-16 ***
## par_catThird or more   824.66      35.54   23.20   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 613.5 on 1765 degrees of freedom
##   (208 observations deleted due to missingness)
## Multiple R-squared:  0.2402, Adjusted R-squared:  0.2393 
## F-statistic: 278.9 on 2 and 1765 DF,  p-value: < 2.2e-16

Dans les résultats, les tests de T nous indiquent que Second est différent de First (la catégorie de référence) et que Third or more est différent de First. Mais on ne peut comparer Second avec Third or more et ces valeurs de T ne sont pas ajustées pour les comparaisons multiples. La fonction emmeans() du package emmeans permettra de générer les informations nécessaires pour faire les contrastes. La fonction pairs() calculera ces contrastes. Par défaut la méthode d’ajustement a posteriori pour comparaison multiple de Tukey-Kramer est utilisée.

library(emmeans)
contrast <- emmeans(modele, "par_cat") #Ici j'ai créé un objet nommé contrast qui contient les éléments dont j'aurai besoin pour comparer les catégories de par_cat
pairs(contrast) #Je demande ensuite les estimés des différentes catégories. 
##  contrast               estimate   SE   df t.ratio p.value
##  First - Second             -715 42.5 1765 -16.848 <.0001 
##  First - Third or more      -825 35.5 1765 -23.200 <.0001 
##  Second - Third or more     -109 36.7 1765  -2.979 0.0082 
## 
## P value adjustment: tukey method for comparing a family of 3 estimates

Nous voyons maintenant toutes les comparaisons possibles. Par exemple les 2ième lactation produisaient 109kg de lait de moins que les 3ième lactation. Et les valeurs de P présentées sont ajustées a posteriori pour les comparaisons multiples.Notez que vous pourriez aussi simplement faire un ajustement a priori (e.g. Bonferroni). Vous n’aurez pas alors à modifier le calcul des valeurs de P ou de vos IC 95%, mais simplement votre seuil α.

Si vous désirez plutôt l’estimé (i.e., le least square means) pour chaque catégorie et son intervalle de confiance, vous pouvez alors simplement utiliser la fonction confint() sur votre contraste:

confint(pairs(contrast))
##  contrast               estimate   SE   df lower.CL upper.CL
##  First - Second             -715 42.5 1765     -815   -615.7
##  First - Third or more      -825 35.5 1765     -908   -741.3
##  Second - Third or more     -109 36.7 1765     -195    -23.3
## 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 3 estimates

On verra alors les différences de production moyenne par catégorie et leurs IC 95. Par exemple, les 1ères lactation produisaient en moyenne 715kg de moins que les 2ième (IC 95: 616, 815). Ces IC 95 sont également ajusté pour les comparaisons multiples.

6.7 Évaluer une interaction entre 2 variables

L’interaction entre 2 variables peut être modélisée de manière très simple, vous n’avez qu’à indiquer dans votre modèle l’interaction entre les variables (parity x dyst). La fonction lm() se chargera alors d’inclure tous les termes nécessaires (i.e., dyst + parity + dyst x parity).

modele<-lm(data=daisy2_mod, milk120 ~ (parity*dyst)) #parity*dyst demandera d'inclure dans le modèle: dyst + parity + dyst*parity
summary(modele)
## 
## Call:
## lm(formula = milk120 ~ (parity * dyst), data = daisy2_mod)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1970.32  -437.44   -17.17   422.63  2149.86 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2741.50      33.93  80.805   <2e-16 ***
## parity        169.51      10.27  16.506   <2e-16 ***
## dyst          -89.58     115.00  -0.779    0.436    
## parity:dyst    30.42      44.90   0.678    0.498    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 650.7 on 1764 degrees of freedom
##   (208 observations deleted due to missingness)
## Multiple R-squared:  0.1455, Adjusted R-squared:  0.1441 
## F-statistic: 100.1 on 3 and 1764 DF,  p-value: < 2.2e-16
anova(modele)
## Analysis of Variance Table
## 
## Response: milk120
##               Df    Sum Sq   Mean Sq  F value Pr(>F)    
## parity         1 126939726 126939726 299.7720 <2e-16 ***
## dyst           1     64457     64457   0.1522 0.6965    
## parity:dyst    1    194401    194401   0.4591 0.4981    
## Residuals   1764 746973355    423454                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Ici, on voit les estimés du modèle et le test de F pour l’interaction (P=0.498).

C’est également possible de demander à voir un graphique illustrant cette interaction (ce sera parfois plus facile à interpréter). Le package sjPlot permet de générer toutes sortes de graphiques à partir de modèles estimés à l’aide des fonctions lm, glm, lme, lmerMod, etc. La fonction plot_model permet de générer une figure, j’indique le nom du modèle (dans ce cas, je l’avais simplement nommé modele) et le type de figure demandée. Ici je demande une figure int illustrant les effets des termes d’intéractions. Le fonction plot_model cherchera les termes d’interaction dans le modèle et fera une figure à l’aide de ceux-ci. La variable apparaissant en premier dans le modèle sera utilisée pour l’axe des x. Pour plus de détails voir Plotting interaction effects of regression models.

library(sjPlot)
plot_model(modele, type="int")
**Figure 6.1.** Effet de parité et dystocie sur la production laitière entre 0 et 120 jours en lait.

Figure 6.1. Effet de parité et dystocie sur la production laitière entre 0 et 120 jours en lait.

Notez que, si un de vos termes d’interaction est catégorique avec > 2 catégories et que vous avez utilisé la fonction factor() qui vous aura permis de bien identifier que cette variable est catégorique, les variables indicateurs seront alors créées automatiquement pour vous (ce qui sera très utile lorsque vous aurez des interactions avec des prédicteurs catégoriques avec > 2 catégories).

6.8 TOL et VIF - Évaluer colinéarité

Afin de détecter les problèmes de colinéarité, on peut demander le calcul du « variance inflation factor » (VIF) à l’aide du package car et de la fonction vif. La tolérance sera simplement (1/VIF). Un VIF > 10 (ou tolérance < 0.10) indiquera un problème sévère de colinéarité.

modele1<-lm(data=daisy2_mod, milk120 ~ (dyst + parity))
library(car)
vif(modele1)
##     dyst   parity 
## 1.017337 1.017337

On a donc un VIF de 1.02 (ou une tolérance de 0.98).

6.9 Évaluation du modèle

L’évaluation du modèle est basée sur différentes procédures diagnostiques. L’évaluation de graphiques constitue une part importante de ce travail.

6.9.1 Évaluer la linéarité de la relation à l’aide de courbes lissées (pour prédicteur quantitatif)

La linéarité de la relation est une supposition importante du modèle. Pour les prédicteurs quantitatifs, vous devrez toujours vérifier si cette supposition est bien respectée. Vous pouvez le faire à l’aide du modèle polynomial (en ajoutant le \(prédicteur^2\) ou le \(prédicteur^2\) et le \(prédicteur^3\) dans votre modèle). Si les coefficients de ces termes sont significativement différents de zéro (i.e. P < 0.05), ont concluera que la relation est une courbe, ou une courbe avec un ou plusieurs points d’inflexion, respectivement.
Mais une représentation graphique de la relation facilite toujours la compréhension. Les courbes lissées (e.g. loess, kernel) permettent de bien visualiser cette relation. Le package ggplot2 et les fonctions ggplot, geom_point et geom_smooth vous permet de réaliser ce genre de graphique. Le code suivant permet de visualiser la relation entre 2 variables continues (wpc et milk120). En jouant avec l’argument span vous pouvez changer le lissage de la courbe. Une petite valeur produira une courbe qui sautille beaucoup, une plus grande valeur produira une courbe plus lisse.

library(ggplot2)
ggplot(daisy2_mod, aes(wpc, milk120)) + #Ici j'ai simplement indiqué le jeu de données, puis les variables d'intérêt
  geom_point() +  #Je demande d'ajouter le nuage de points (un 'scatterplot')
  geom_smooth(method="loess", span=2)+ #Je demande d'ajouter la courbe lissée de type loess. L'argument span me permet d'ajuster le lissage 
  theme_bw() #J'aime bien avoir un fond blanc pour mes figures (un thème noir et blanc; theme_bw). C'est futile, mais bon...
**Figure 6.2.** Relation entre le nombre de jours jusqu’à la saillie fécondante (wpc) et la production de lait en 120j (milk120) avec courbe lissée avec un facteur de 2.

Figure 6.2. Relation entre le nombre de jours jusqu’à la saillie fécondante (wpc) et la production de lait en 120j (milk120) avec courbe lissée avec un facteur de 2.

6.9.2 Méthodes diagnostiques pour les résiduels

La fonction plot() demande les principaux graphiques qui serviront à évaluer l’adéquation du modèle (i.e. l’homoscédasticité et la normalité des résiduels).
Les plus intéressants sont probablement :
• Le graphique des Résiduels x valeurs prédites (Residual vs Fitted). Ce graphique vous permettra de visualiser si la variance est homogène en fonction des valeurs prédites. On désire une « bande » horizontale égale (semble assez problématique pour cette exemple; la bande va en augmentant)
• Le graphique des quantiles x résiduels (Normal Q-Q) permet d’évaluer la normalité des résiduels. On désire que les points forment une ligne de 45º qui se superpose à la ligne pointillée dans la figure (encore assez problématique dans cet exemple)

modele2<-lm(data=daisy2_mod, wpc ~ (dyst + parity + herd_size + twin))
plot(modele2, 1) #Je demande la première figure du 'pannel plot' de diagnostique (c'est la figure Residual vs Fitted)
**Figure 6.3** Graphique des résiduels x valeurs prédites.

Figure 6.3 Graphique des résiduels x valeurs prédites. 

plot(modele2, 2) #Je demande la 2ième figure du 'pannel plot' de diagnostique (c'est la figure Normal Q-Q)
**Figure 6.4.** Graphique Q-Q des résiduels.

Figure 6.4. Graphique Q-Q des résiduels. 

#Alternativement, je pourrais ne pas spécifier les figures qui m'intéressent et simplement tout demander ainsi:
#plot(modele2)
#Vous aurez alors toute la série (n=4) de graphiques

6.9.3 Évaluation des observations extrêmes et/ou influentes

Certaines observations peuvent être très différentes des autres et avoir un effet important sur les résultats de la régression. Cette observation peut être une observation extrême (outlier), c’est-à-dire une observation avec une combinaison inhabituelle de valeurs pour la variable dépendante et les variables indépendantes. Ce peut être une observation avec une valeur extrême pour un prédicteur, que l’on appelle variable à effet levier (leverage). Enfin ce peut être une observation qui, si elle est soustraite à l’analyse, change les estimés des coefficients (influence).

Dans R, vous pouvez facilement ajouter dans votre base de données les valeurs prédites par le modèle, les résiduels, distances de Cook, leviers, etc avec la fonction augment() du package broom. Vous pourrez ensuite trier cette table pour identifier, par exemple, les observations avec les résiduels, leviers ou distance de Cook les plus extrêmes et essayer de comprendre si ces observations ont quelque chose en commun.

library(broom)
diag <- augment(modele2) #Je viens de créer une nouvelle table dans laquelle les résiduels, distance de cook, etc se trouvent maintenant
head(diag)
## # A tibble: 6 x 12
##   .rownames   wpc  dyst parity herd_size  twin .fitted .resid    .hat .sigma
##   <chr>     <int> <int>  <int>     <int> <int>   <dbl>  <dbl>   <dbl>  <dbl>
## 1 3            67     0      5       294     0    78.0  -11.0 0.00239   50.4
## 2 4             9     0      5       294     0    78.0  -69.0 0.00239   50.4
## 3 5            61     0      5       294     0    78.0  -17.0 0.00239   50.4
## 4 8           117     0      5       294     0    78.0   39.0 0.00239   50.4
## 5 9            36     0      6       294     0    79.2  -43.2 0.00397   50.4
## 6 11           19     0      5       294     0    78.0  -59.0 0.00239   50.4
## # ... with 2 more variables: .cooksd <dbl>, .std.resid <dbl>

Les nouvelles variables correspondent à:
- Valeur prédite (.fitted)
- Résiduel (.resid)
- Levier (.hat)
- Distance de Cook (.cooksd)
- Résiduel standardisé (.std.resid)

À l’aide de la fonction ggplot vous pourrez alors produire les graphiques qui vous intéressent. Par exemple :

ggplot(diag, aes(wpc, .std.resid, colour=.std.resid)) + #J'indique les variables d'intérêt. Je me sui permis une petite fantaisie ici, je change la couleur des points en fonction de la valeur du résiduel standardisé
  geom_point() + #Je demande un graphique nuage de points
  geom_hline (aes(yintercept=3)) + #Une autre fantaisie, ajoutons des barres horizontales qui permettent de marquer les valeurs -3 et +3 (pour identifier les résiduels 'extrêmes')
  geom_hline (aes(yintercept=-3)) +
  theme_bw() #Mon fameux fond blanc!
**Figure 6.5.** Graphique des résiduels de Student par jours jusqu’à la saillie fécondante (wpc).

Figure 6.5. Graphique des résiduels de Student par jours jusqu’à la saillie fécondante (wpc).

Dans ce cas, on voit que seulement les vaches avec un WPC long (> 250j) ont des résiduels larges (i.e. > 3.0 ou < -3.0). Le modèle semble donc avoir de la difficulté à bien prédire ces observations.

6.10 Travaux pratiques 1 - Régression linéaire - Base

6.10.1 Exercices

Pour ce TP utilisez le fichier DAISY2 (voir description VER p.809).

Ne sélectionnez que les 7 troupeaux avec h7=1.

1) Considérons le nombre de jours jusqu’à la saillie fécondante (WPC) comme variable dépendante et vérifions comment différents prédicteurs permettent de prédire cet intervalle.

a. Représentez graphiquement l’association entre milk120 et WPC. Pensez-vous qu’une ligne droite passant au travers des points capture adéquatement la relation entre ces deux variables ?

b. Faites varier le lissage (e.g. 0.1 ou 1) et décrivez comment la courbe lissée change en fonction de ce lissage.

c. Maintenant, représentez graphiquement la relation entre parity et wpc. Dans ce cas, pensez-vous qu’une ligne droite passant au travers des points capture adéquatement la relation entre ces deux variables ?

d. À partir du diagramme de dispersion, il est raisonnable de penser que l’intervalle WPC change linéairement avec parity. Cette relation linéaire peut être exprimée par le modèle \(WPC= β_0 + β_1*parity\). À l’aide d’un modèle de régression linéaire, estimez les valeurs de \(β_0\) et \(β_1\). Écrivez l’équation de régression sous la forme donnée ci-dessus, avec ces estimés dans l’équation. Comment interprétez-vous ces estimés ?

e. Un test de F vous est rapporté pour le modèle de même qu’un test de T pour le coefficient de régression de parity (i.e. \(β_1\)). Quelles sont les hypothèses nulles pour chacun de ces tests? Dans ce cas, ces 2 tests sont-ils réellement différents?

f. Quel serait l’IC95% pour le coefficient de régression de parity?

g. Existe-t’il une relation linéaire statistiquement significative entre ces 2 variables?

h. Le nombre de jours jusqu’à la saillie fécondante (WPC) pour une parité zéro n’a bien sûr pas de sens biologique. Pour repositionner ce paramètre à la parité minimale observée (i.e. parity=1), on peut remplacer la parité par une nouvelle variable (parity_ct) centrée sur parity=1. Créez cette nouvelle variable et, à l’aide d’un modèle de régression linéaire, estimez les valeurs de \(β_0\) et \(β_1\) et interprétez les coefficients de régression comme à la question 1.d.

2) À la question 1.a, nous avons vu que la relation entre milk120 et WPC ne semble pas être linéaire. Nous pourrions donc créer des termes polynomiaux afin de modéliser correctement cette association.

a. Créez une nouvelle variable milk120_ct centrée sur la production moyenne. Puis créez 1 terme polynomial milk120_ct_sq (i.e. milk120 au carré). Vérifiez si l’ajout d’une courbe (i.e. le terme au carré) ajoute significativement au modèle.

b. Selon votre analyse graphique réalisée à la question 1.a, pensez-vous que vous auriez besoin d’ajouter d’autres points d’inflexions pour bien représenter cette association? Vérifiez votre réponse en ajoutant un terme au cube pour milk120 en plus du terme au carré.

c. Dans ce dernier modèle, vérifiez qu’il n’y a pas de problème sévère de colinéarité.

3) Dans le modèle suivant \(wpc = β_0 +β_1parityct + β_2twin + β_3dyst\) vous vous demandez si les problèmes de vêlage (i.e. twin et dyst ensemble) apporte significativement au modèle. Quel test pourriez-vous réaliser afin de répondre à cette question? Quel est le résultat de ce test et votre interprétation de ce résultat?

4) Recodez maintenant parity afin d’avoir une nouvelle variable catégorique (parity_cat) à 3 niveaux (parity 1, parity 2 et parity ≥3). Vérifiez la relation entre parity_cat et WPC en vous assurant d’avoir parity 1 comme valeur de référence.

a. Est-ce que parity_cat (comme variable) est significativement associée à WPC?

b. De combien WPC change pour une vache de 2ième parité comparativement à une vache de 1ère parité?

c. Quel est le WPC pour une vache de 1ère parité?

d. Quelle est la différence de WPC entre une 2ième et une 3ième parité et quel est l’IC 95% ajusté pour comparaisons multiples pour cette différence? Cette différence est-elle statistiquement significative?

5) Vous supposez que l’effet d’une dystocie (dyst) sur WPC varie en fonction de la parité (catégorique 1ère, 2ième, ou ≥3ième). Par exemple, une vache plus vieille ayant une dystocie aura possiblement un délai plus long jusqu’à la saille fécondante comparativement à une vache plus jeune.

a. Que devrez-vous tester pour vérifier cette hypothèse?

b. Effectuez ce test. Est-ce que l’effet de dystocie varie de manière statistiquement significative en fonction de la parité?

c. Quel est le nombre de jours moyen jusqu’à la saillie fécondante pour chacune des catégories de parité et de dystocie (i.e. remplir le tableau suivant)? Pour quel niveau de parité les différences semblent les plus importantes?

Table 6.1. Nombre moyen estimé de jours jusqu’à la saillie fécondante pour chacune des catégories de parité et de dystocie
Parite Dystocie_0 Dystocie_1
1ère lactation
2ième lactation
3ième ou plus

6.10.2 Code R et réponses

Pour ce TP utilisez le fichier DAISY2 (voir description VER p.809).
Ne sélectionnez que les 7 troupeaux avec h7=1. 

#J'ouvre le jeu de données
daisy2 <-read.csv(file="daisy2.csv", header=TRUE, sep=",")
daisy2_mod<-subset(daisy2, h7==1)

1) Considérons le nombre de jours jusqu’à la saillie fécondante (WPC) comme variable dépendante et vérifions comment différents prédicteurs permettent de prédire cet intervalle.

a. Représentez graphiquement l’association entre milk120 et WPC. Pensez-vous qu’une ligne droite passant au travers des points capture adéquatement la relation entre ces deux variables ?

library(ggplot2)
ggplot(daisy2_mod, aes(milk120, wpc)) + #Ici j'ai simplement indiqué le jeu de données, puis les variables d'intérêt
  geom_point() +  #Je demande d'ajouter le nuage de points (un 'scatterplot')
  geom_smooth(method="loess", span=2)+ #Je demande d'ajouter la courbe lissée de type loess. L'argument span me permet d'ajuster le lissage 
  theme_bw() #J'aime bien avoir un fond blanc pour mes figures (un thème noir et blanc; theme_bw). C'est futile, mais bon...
**Figure 6.6.** Relation entre la production de lait en 120j (milk120) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Figure 6.6. Relation entre la production de lait en 120j (milk120) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Réponse: Non, relation semble légèrement curvilinéaire

b. Faites varier le lissage (e.g. 0.1 ou 1) et décrivez comment la courbe lissée change en fonction de ce lissage.

ggplot(daisy2_mod, aes(milk120, wpc)) + 
  geom_point() +  
  geom_smooth(method="loess", span=0.2)+ 
  theme_bw()
**Figure 6.7.** Relation entre la production de lait en 120j (milk120) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 0.2.

Figure 6.7. Relation entre la production de lait en 120j (milk120) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 0.2.

Réponse: Lorsqu’on réduit le span, la courbe permet de visualiser toutes les petites variations. Elle devient plus droite (i.e. plus insensible aux variations) lorsque le span augmente.

c. Maintenant, représentez graphiquement la relation entre parity et wpc. Dans ce cas, pensez-vous qu’une ligne droite passant au travers des points capture adéquatement la relation entre ces deux variables ?

ggplot(daisy2_mod, aes(parity, wpc)) + 
  geom_point() +  
  geom_smooth(method="loess", span=2)+ 
  theme_bw()
**Figure 6.8.** Relation entre parité (parity) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Figure 6.8. Relation entre parité (parity) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Réponse: Oui, semble mieux

d. À partir du diagramme de dispersion, il est raisonnable de penser que l’intervalle WPC change linéairement avec parity. Cette relation linéaire peut être exprimée par le modèle \(WPC= β_0 + β_1*parity\). À l’aide d’un modèle de régression linéaire, estimez les valeurs de \(β_0\) et \(β_1\). Écrivez l’équation de régression sous la forme donnée ci-dessus, avec ces estimés dans l’équation. Comment interprétez-vous ces estimés ?

modele1<-lm(data=daisy2_mod, wpc ~ (parity)) #J'ai créé un nouvel objet qui s'appelle modele1 et qui est une régression des variables parity sur wpc
modele1 #Je demande à voir l'objet modele
## 
## Call:
## lm(formula = wpc ~ (parity), data = daisy2_mod)
## 
## Coefficients:
## (Intercept)       parity  
##      65.218        1.312

Réponse: \(WPC= 65.2 + 1.3*parity\)
Intervalle WPC moyen quand parité=0 est de 65.2j. On ajoute ensuite 1.3 jours à chaque fois qu’on ajoute une parité.

e. Un test de F vous est rapporté pour le modèle de même qu’un test de T pour le coefficient de régression de parity (i.e. \(β_1\)). Quelles sont les hypothèses nulles pour chacun de ces tests? Dans ce cas, ces 2 tests sont-ils réellement différents?

summary(modele1)
## 
## Call:
## lm(formula = wpc ~ (parity), data = daisy2_mod)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -67.47 -38.47 -15.15  24.16 227.53 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  65.2181     2.7090  24.075   <2e-16 ***
## parity        1.3118     0.8706   1.507    0.132    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 51.58 on 1572 degrees of freedom
##   (402 observations deleted due to missingness)
## Multiple R-squared:  0.001442,   Adjusted R-squared:  0.000807 
## F-statistic: 2.271 on 1 and 1572 DF,  p-value: 0.1321

Réponse: Test de F (P=0.132): tous les coefficients (outre \(β_0\), l’intercept) = 0
Test de T (aussi P=0.132): le coefficient de parity (\(β_1\)) = 0
Non, puisqu’il y a un seul coefficient de régression dans l’équation les 2 tests sont équivalents.

f. Quel serait l’IC95% pour le coefficient de régression de parity?

confint(modele1)
##                  2.5 %    97.5 %
## (Intercept) 59.9045164 70.531662
## parity      -0.3958026  3.019367

Réponse: -0.4 à 3.0 jours

g. Existe-t’il une relation linéaire statistiquement significative entre ces 2 variables?
Réponse: Non (P=0.13 et IC95% inclus 0)

h. Le nombre de jours jusqu’à la saillie fécondante (WPC) pour une parité zéro n’a bien sûr pas de sens biologique. Pour repositionner ce paramètre à la parité minimale observée (i.e. parity=1), on peut remplacer la parité par une nouvelle variable (parity_ct) centrée sur parity=1. Créez cette nouvelle variable et, à l’aide d’un modèle de régression linéaire, estimez les valeurs de \(β_0\) et \(β_1\) et interprétez les coefficients de régression comme à la question 1.d.

daisy2_mod$par_ct <- daisy2_mod$parity-1
modele2<-lm(data=daisy2_mod, wpc ~ (par_ct)) 
modele2
## 
## Call:
## lm(formula = wpc ~ (par_ct), data = daisy2_mod)
## 
## Coefficients:
## (Intercept)       par_ct  
##      66.530        1.312

Réponse: Intervalle wpc moyen quand parité=1 est de 66.5j. On ajoute ensuite 1.3 jours à chaque fois qu’on ajoute une parité.

2) À la question 1.a, nous avons vu que la relation entre milk120 et WPC ne semble pas être linéaire. Nous pourrions donc créer des termes polynomiaux afin de modéliser correctement cette association.

a. Créez une nouvelle variable milk120_ct centrée sur la production moyenne. Puis créez 1 terme polynomial milk120_ct_sq (i.e. milk120 au carré). Vérifiez si l’ajout d’une courbe (i.e. le terme au carré) ajoute significativement au modèle.

#Vérifions d'abord quelle est la moyenne de milk120
mean(daisy2_mod$milk120, na.rm=TRUE)
## [1] 3225.311
#Je créé la variable centrée sur 3225 et celle au carré
daisy2_mod$milk120_ct <- daisy2_mod$milk120-3225
daisy2_mod$milk120_ct_sq <-daisy2_mod$milk120_ct*daisy2_mod$milk120_ct
#Vérifions que ça a bien focntionné
head(daisy2_mod)
##   region herd cow study_lact herd_size mwp parity milk120    calv_dt cf fs cc
## 1      1    1   1          1       294  26      5  3505.8 1996-11-11 80 NA NA
## 2      1    1   2          1       294  26      5  3691.3 1997-01-12 64 NA NA
## 3      1    1   3          1       294  26      5  4173.0 1997-01-17 71  0 93
## 4      1    1   4          1       294  26      5  3727.3 1997-02-11 35  1 35
## 5      1    1   5          1       294  26      5  3090.8 1997-06-26 47  0 87
## 6      1    1   6          1       294  26      4  5041.2 1996-10-16 NA NA NA
##   wpc spc twin dyst rp vag_disch h7 par_ct milk120_ct milk120_ct_sq
## 1  NA   6    0    0  0         0  1      4      280.8      78848.67
## 2  NA   3    0    0  0         0  1      4      466.3     217435.74
## 3  67   2    0    0  0         0  1      4      948.0     898704.00
## 4   9   1    0    0  0         0  1      4      502.3     252305.34
## 5  61   2    0    0  0         0  1      4     -134.2      18009.63
## 6  NA  NA    0    0  1         0  1      3     1816.2    3298583.15
#Je vérifie le modèle avec les termes polynomiaux
modele3<-lm(data=daisy2_mod, wpc ~ (milk120_ct+milk120_ct_sq)) 
summary(modele3)
## 
## Call:
## lm(formula = wpc ~ (milk120_ct + milk120_ct_sq), data = daisy2_mod)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -66.34 -38.70 -15.26  25.28 222.44 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    6.697e+01  1.639e+00  40.856   <2e-16 ***
## milk120_ct    -2.545e-03  1.892e-03  -1.345   0.1787    
## milk120_ct_sq  4.089e-06  1.998e-06   2.046   0.0409 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 51.65 on 1533 degrees of freedom
##   (440 observations deleted due to missingness)
## Multiple R-squared:  0.003696,   Adjusted R-squared:  0.002396 
## F-statistic: 2.843 on 2 and 1533 DF,  p-value: 0.05854

Réponse: Oui, le terme au carré est significativement associé (i.e. P = 0.04) à wpc. Donc le terme représentant la courbe à un coefficient différent de 0.

b. Selon votre analyse graphique réalisée à la question 1.a, pensez-vous que vous auriez besoin d’ajouter d’autres points d’inflexions pour bien représenter cette association? Vérifiez votre réponse en ajoutant un terme au cube pour milk120 en plus du terme au carré.

Réponse: a priori, ça semblait être une simple courbe.

#Je créé une variable milk120 à la puissance 3
daisy2_mod$milk120_ct_cu <-daisy2_mod$milk120_ct_sq*daisy2_mod$milk120_ct
#Je l'ajoute au modèle
modele4<-lm(data=daisy2_mod, wpc ~ (milk120_ct+milk120_ct_sq+milk120_ct_cu)) 
summary(modele4)
## 
## Call:
## lm(formula = wpc ~ (milk120_ct + milk120_ct_sq + milk120_ct_cu), 
##     data = daisy2_mod)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -68.71 -38.40 -15.64  25.59 223.22 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    6.724e+01  1.650e+00  40.761   <2e-16 ***
## milk120_ct    -6.171e-03  3.163e-03  -1.951   0.0513 .  
## milk120_ct_sq  3.330e-06  2.067e-06   1.611   0.1073    
## milk120_ct_cu  2.651e-09  1.854e-09   1.430   0.1530    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 51.63 on 1532 degrees of freedom
##   (440 observations deleted due to missingness)
## Multiple R-squared:  0.005023,   Adjusted R-squared:  0.003075 
## F-statistic: 2.578 on 3 and 1532 DF,  p-value: 0.05222

Effectivement, le terme au cube à P=0.15 (i.e. n’ajoute rien au modèle).

c. Dans ce dernier modèle, vérifiez qu’il n’y a pas de problème sévère de colinéarité.

library(car)
vif(modele4)
##    milk120_ct milk120_ct_sq milk120_ct_cu 
##      2.808468      1.074436      2.918711

Réponse: Les VIF sont tous < 10, donc pas de problème.

3) Dans le modèle suivant \(wpc = β_0 +β_1parityct + β_2twin + β_3dyst\) vous vous demandez si les problèmes de vêlage (i.e. twin et dyst ensemble) apporte significativement au modèle. Quel test pourriez-vous réaliser afin de répondre à cette question? Quel est le résultat de ce test et votre interprétation de ce résultat?

Réponse: Test de F pour comparer modèle complet (i.e. parity_ct, twin et dyst) vs. modèle réduit (i.e. parity_ct).

modele_complet <- lm(data=daisy2_mod, wpc ~ (par_ct+twin+dyst))
modele_reduit <- lm(data=daisy2_mod, wpc ~ (par_ct))
anova(modele_complet, modele_reduit)
## Analysis of Variance Table
## 
## Model 1: wpc ~ (par_ct + twin + dyst)
## Model 2: wpc ~ (par_ct)
##   Res.Df     RSS Df Sum of Sq      F  Pr(>F)  
## 1   1570 4167004                              
## 2   1572 4182050 -2    -15046 2.8345 0.05905 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

P =0.06, donc ces variables, ensemble, n’apporte pas au modèle (i.e. les coefficients de régression ne sont pas différent de 0).

4) Recodez maintenant parity afin d’avoir une nouvelle variable catégorique (parity_cat) à 3 niveaux (parity 1, parity 2 et parity ≥3). Vérifiez la relation entre parity_cat et WPC en vous assurant d’avoir parity 1 comme valeur de référence.

#Je créé une variable parity catégorique:
daisy2_mod$par_cat <- cut(daisy2_mod$parity, breaks = c(0, 1, 2, Inf), labels = c("First", "Second", "Third or more"))
#Je fixe le niveau de référence
#J'écris le modèle
daisy2_mod<-within(daisy2_mod, par_cat<-relevel(par_cat, ref="First")) #Sélection de la valeur de référence par_cat=1
modele5 <- lm(data=daisy2_mod, wpc ~ (par_cat))
summary(modele5)
## 
## Call:
## lm(formula = wpc ~ (par_cat), data = daisy2_mod)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -67.54 -38.21 -15.54  24.46 227.46 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           66.9520     2.5270  26.495   <2e-16 ***
## par_catSecond          0.2592     3.6750   0.071    0.944    
## par_catThird or more   3.5895     3.1284   1.147    0.251    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 51.6 on 1571 degrees of freedom
##   (402 observations deleted due to missingness)
## Multiple R-squared:  0.001132,   Adjusted R-squared:  -0.0001392 
## F-statistic: 0.8905 on 2 and 1571 DF,  p-value: 0.4106

a. Est-ce que parity_cat (comme variable) est significativement associée à WPC?
Réponse: Non, le test de F qui teste tous les coeffients ensemble donne P=0.41

b. De combien WPC change pour une vache de 2ième parité comparativement à une vache de 1ère parité?
Réponse: +0.3 jours

c. Quel est le WPC pour une vache de 1ère parité?
Réponse: 67.0 jours

d. Quelle est la différence de WPC entre une 2ième et une 3ième parité et quel est l’IC 95% ajusté pour comparaisons multiples pour cette différence? Cette différence est-elle statistiquement significative?

library(emmeans)
contrast <- emmeans(modele5, "par_cat") #Ici j'ai créé un objet nommé contrast qui contient les éléments dont j'aurai besoin pour comparer les catégories de par_cat
pairs(contrast) #Je demande ensuite de comparer les différentes catégories. 
##  contrast               estimate   SE   df t.ratio p.value
##  First - Second           -0.259 3.68 1571 -0.071  0.9973 
##  First - Third or more    -3.589 3.13 1571 -1.147  0.4850 
##  Second - Third or more   -3.330 3.24 1571 -1.027  0.5601 
## 
## P value adjustment: tukey method for comparing a family of 3 estimates
#Pour voir les intervalle de confiance, je pourrais demander un confint() sur cet fonction pairs()
confint(pairs(contrast))
##  contrast               estimate   SE   df lower.CL upper.CL
##  First - Second           -0.259 3.68 1571    -8.88     8.36
##  First - Third or more    -3.589 3.13 1571   -10.93     3.75
##  Second - Third or more   -3.330 3.24 1571   -10.94     4.28
## 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 3 estimates

Réponse: 3.3 jours de plus pour une 3ième parité (vs. 2ième). IC95: -4.3 à 10.9 jours de plus. Ce n’est pas une différence statistiquement significative (la valeur zéro est incluse dans l’IC95).

5) Vous supposez que l’effet d’une dystocie (dyst) sur WPC varie en fonction de la parité (catégorique 1ère, 2ième, ou ≥3ième). Par exemple, une vache plus vieille ayant une dystocie aura possiblement un délai plus long jusqu’à la saille fécondante comparativement à une vache plus jeune.

a. Que devrez-vous tester pour vérifier cette hypothèse?
Réponse: L’interaction entre dyst et par_cat.

b. Effectuez ce test. Est-ce que l’effet de dystocie varie de manière statistiquement significative en fonction de la parité?

modele6 <- lm(data=daisy2_mod, wpc ~ (par_cat*dyst))
summary(modele6)
## 
## Call:
## lm(formula = wpc ~ (par_cat * dyst), data = daisy2_mod)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -84.00 -37.65 -15.47  24.53 228.35 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                67.0249     2.7110  24.724   <2e-16 ***
## par_catSecond               0.4429     3.8446   0.115   0.9083    
## par_catThird or more        2.6221     3.2911   0.797   0.4257    
## dyst                       -0.5428     7.3977  -0.073   0.9415    
## par_catSecond:dyst         -5.1015    14.7724  -0.345   0.7299    
## par_catThird or more:dyst  33.8958    13.5848   2.495   0.0127 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 51.51 on 1568 degrees of freedom
##   (402 observations deleted due to missingness)
## Multiple R-squared:  0.006688,   Adjusted R-squared:  0.00352 
## F-statistic: 2.111 on 5 and 1568 DF,  p-value: 0.0615

Réponse: Notez que j’ai maintenant 2 coefficients (par_catSecond:dyst et par_catThird or more:dyst) qui, ensemble, représentent l’interaction entre par_cat et dyst. Je dois donc faire un test de F sur ces 2 coefficients à la fois.

#Le modèle réduit sans les deux coefficients:
modele_red <- lm(data=daisy2_mod, wpc ~ (par_cat+dyst))
#La fonction anova() pour comparer les modèles:
anova(modele6, modele_red)
## Analysis of Variance Table
## 
## Model 1: wpc ~ (par_cat * dyst)
## Model 2: wpc ~ (par_cat + dyst)
##   Res.Df     RSS Df Sum of Sq      F  Pr(>F)  
## 1   1568 4160082                              
## 2   1570 4179615 -2    -19533 3.6812 0.02541 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Oui l’interaction est significative, j’obtiens une valeur de P=0.03 pour le test de F.

c. Quel est le nombre de jours moyen jusqu’à la saillie fécondante pour chacune des catégories de parité et de dystocie (i.e. remplir le tableau suivant)? Pour quel niveau de parité les différences semblent les plus importantes?

Table 6.2. Nombre moyen estimé de jours jusqu’à la saillie fécondante pour chacune des catégories de parité et de dystocie
Parite Dystocie_0 Dystocie_1
1ère lactation 67.0 jours 67.0-0.5=66.5 jours
2ième lactation 67.0+0.4=67.4 jours 67.0+0.4-0.5-5.1=61.8 jours
3ième ou plus 67.0+2.6=69.6 jours 67.0+2.6-0.5+33.9=103.0 jours

6.11 Travaux pratiques 2 - Régression linéaire - Évaluation du modèle

6.11.1 Exercices

Pour ce TP utilisez le fichier DAISY2 (voir description VER p.809).

Ne sélectionnez que les 7 troupeaux avec h7=1.

Nous nous intéresserons d’abord au modèle suivant qui permet d’évaluer l’effet de dystocie (dyst) sur le nombre de jours jusqu’à la saillie fécondante (WPC). Cette association est ajustée pour 3 facteurs confondants (parity, herd_size et twin). Un des confondants (herd_size) n’a pas une relation linéaire avec WPC. Cette relation a donc due être modélisée avec l’ajout d’un terme quadratique. Finalement, l’interaction entre dystocie et parité est également d’intérêt.

\(wpc = β_0 +β_1dyst + β_2parity + β_3dyst*parity + β_4herdsize + β_5herdsize^2 + β_6twin\)

1) D’abord vous pourriez créer les nouvelles variables centrées et quadratiques qui seront utilisées dans ce modèle.

\(Parity\) pourrait être centrée sur une première lactation.
\(Herdsize\) pourrait être centré sur 250 vaches.
\(Herdsize^2\) sera, en fait, votre variable herd_size centrée et mise au carré.

Maintenant, estimez ce modèle à l’aide de la fonction lm et évaluer d’abord graphiquement les suppositions de normalité des résiduels (i.e. l’histogramme des résiduel et le Q-Q plot) et d’homoscédasticité de la variance (i.e. les résiduels x valeurs prédites). Quels sont vos conclusions ? Notez qu’un simple histogramme de WPC vous aurait possiblement aussi indiqué les problèmes potentiels avec la variable WPC.

2) Afin d’améliorer les suppositions du modèle (i.e. normalité des résiduels et homoscédasticité), vous pourriez tenter de transformer WPC. Essayez les transformations suivantes et utilisées les comme variables dépendantes dans votre modèle à la place de WPC. Dans quels cas les suppositions de normalité et d’homoscédasticité sont améliorées et quelle transformation préféreriez-vous utiliser?

  1. Le log naturel de WPC
  1. Normalité des résiduels ?
  2. Homoscédasticité ?
  1. L’inverse de WPC (1/WPC)
  1. Normalité des résiduels ?
  2. Homoscédasticité ?
  1. La racine carrée de WPC
  1. Normalité des résiduels ?
  2. Homoscédasticité ?

3) Outre l’amélioration des suppositions du modèle, est-ce que la transformation par le logarithme naturel pourrait vous offrir d’autres avantages comparativement, par exemple, à la transformation par la racine carrée?

4) Vous décidez donc de continuer à travailler avec le logarithme naturel de WPC. Rappelez-vous que lorsque vous aviez évalué la relation entre herd_size et WPC, cette relation semblait curvilinéaire. Est-ce que cela implique que la relation entre herd_size et le logarithme naturel de WPC est également curvilinéaire ?

5) Évaluez graphiquement et à l’aide de termes quadratique et cubique la relation entre herd_size et le logarithme naturel de WPC. Avez-vous besoin d’inclure un terme au carré ? Un terme au cube ?

6) Dans votre modèle avec le logarithme naturel de WPC, et herd_size modélisé avec les termes polynomiaux appropriés, est-ce que l’interaction entre dyst et parity est toujours statistiquement significative ?

7) Si l’interaction n’est plus statistiquement significative cela signifie que:

  1. L’effet de dystocie ne varie pas en fonction de la parité
  2. Le terme d’interaction n’est pas nécessaire dans le modèle
  3. Le coefficient de régression pour le terme d’interaction n’est pas différent de zéro
  4. Toutes ces réponses

8) Comme vous avez pu le noter, transformer la variable dépendante vous oblige à revoir pratiquement tout votre modèle de A à Z. Mais bon, votre modèle final pourrait donc être :

\(log(wpc) = β_0 +β_1dyst + β_2parity_c + β_3herdsize _c + β_4herdsize_c^2 + β_5twin\)

Évaluez une dernière fois les suppositions de normalité des résiduels et d’homoscédasticité (puisque vous ne l’avez pas encore fait pour ce modèle sans l’interaction \(dyst*parity\)) et calculez dans une nouvelle table les valeurs prédites, les résiduels de Student, les leviers et les distances de Cook.

  1. Combien d’observations ont des résiduels larges (résiduels de Student > 3.0 ou < -3.0)? Ont-elles quelque chose en commun en ce qui a trait à leurs valeurs de WPC, dyst, parity, herd_size ou twin?

  2. Vous pourriez représenter graphiquement les résiduels de Student en fonction de WPC pour mieux visualiser où se situent ses résiduels larges. Quel genre d’observations (en termes de WPC) le modèle semble avoir de la difficulté à prédire?

  3. Évaluez maintenant les 5 ou 10 observations avec les leviers les plus élevés. Encore une fois, ont-elles quelque chose en commun?

  4. Les observations avec des résiduels ou des leviers larges (ou les deux) sont des observations qui peuvent potentiellement influencer le modèle de régression. Les distances de Cook nous permettrons d’identifier quelles observations avaient effectivement une influence sur le modèle. Évaluez donc maintenant les 5 ou 10 observations avec les distances de Cook les plus élevées. Ont-elles quelque chose en commun ?

  5. Vérifiez maintenant jusqu’à quel point ces observations influencent vos résultats en calculant de nouveau votre modèle mais sans les observations avec les distance de Cook les plus élevées (e.g. les 7 observations avec les distances de Cook > 0.010). Est-ce que les conclusions des tests de F ou de T changent comparativement au modèle calculé au début de la question 8? Est-ce que les estimés obtenus changent beaucoup ? Pour quel paramètre l’estimé semble être le plus affecté ? Est-ce en accord avec votre réponse à la question 8.d. ?

6.11.2 Code R et réponses

1) D’abord vous pourriez créer les nouvelles variables centrées et quadratiques qui seront utilisées dans ce modèle. Maintenant, estimez ce modèle à l’aide de la fonction lm et évaluer d’abord graphiquement les suppositions de normalité des résiduels (i.e. l’histogramme des résiduel et le Q-Q plot) et d’homoscédasticité de la variance (i.e. les résiduels x valeurs prédites). Quels sont vos conclusions? Notez qu’un simple histogramme de WPC vous aurait possiblement aussi indiqué les problèmes potentiels avec la variable WPC.

#J'ouvre le jeu de données
daisy2 <-read.csv(file="daisy2.csv", header=TRUE, sep=",")
daisy2_mod<-subset(daisy2, h7==1)

#Je génère les nouvelles variables
daisy2_mod$par_ct <- daisy2_mod$parity-1
daisy2_mod$herd_size_ct <- daisy2_mod$herd_size-250
daisy2_mod$herd_size_ct_sq <-daisy2_mod$herd_size_ct*daisy2_mod$herd_size_ct

#Je génère le modèle
modele1<-lm(data=daisy2_mod, wpc ~ (dyst*par_ct + herd_size_ct + herd_size_ct_sq + twin))
plot(modele1, 2) #Je demande la 2 figure Normal Q-Q
**Figure 6.9.** Graphique Q-Q des résiduels.

Figure 6.9. Graphique Q-Q des résiduels.

Réponse: La normalité des résiduels est problématique

plot(modele1, 1) #Je demande la la figure Residual vs Fitted
**Figure 6.10.** Graphique des résiduels x valeurs prédites.

Figure 6.10. Graphique des résiduels x valeurs prédites.

Réponse: Il semble aussi y avoir un problème d’hétéroscédascticité (i.e. la variance augmente avec l’augmentation des valeurs prédites).

2) Afin d’améliorer les suppositions du modèle (i.e. normalité des résiduels et homoscédasticité), vous pourriez tenter de transformer WPC. Essayez les transformations suivantes et utilisées les comme variables dépendantes dans votre modèle à la place de WPC. Dans quels cas les suppositions de normalité et d’homoscédasticité sont améliorées et quelle transformation préféreriez-vous utiliser?

#Je génère les nouvelles variables en bloc:
daisy2_mod$ln_wpc <- log(daisy2_mod$wpc)
daisy2_mod$inv_wpc <- 1/daisy2_mod$wpc
daisy2_mod$sqr_wpc <- sqrt(daisy2_mod$wpc)
  1. Le log naturel de WPC
  1. Normalité des résiduels ?
  2. Homoscédasticité ?
#Je génère le modèle pour log_wpc
modele_log<-lm(data=daisy2_mod, ln_wpc ~ (dyst*par_ct + herd_size_ct + herd_size_ct_sq + twin))

plot(modele_log, 1) #Je demande la la figure Residual vs Fitted
**Figure 6.11.** Graphique des résiduels x valeurs prédites.

Figure 6.11. Graphique des résiduels x valeurs prédites. 

plot(modele_log, 2) #Je demande la 2 figure Normal Q-Q
**Figure 6.12.** Graphique Q-Q des résiduels.

Figure 6.12. Graphique Q-Q des résiduels.

Réponse: Normalité est très améliorée; homoscédasticité est beaucoup mieux. Peut-être une légère diminution de la variance avec augmentation des valeurs prédites.

  1. L’inverse de WPC (1/WPC)
  1. Normalité des résiduels ?
  2. Homoscédasticité ?
#Je génère le modèle pour inv_wpc
modele_inv<-lm(data=daisy2_mod, inv_wpc ~ (dyst*par_ct + herd_size_ct + herd_size_ct_sq + twin))

plot(modele_inv, 1) #Je demande la la figure Residual vs Fitted
**Figure 6.13.** Graphique des résiduels x valeurs prédites.

Figure 6.13. Graphique des résiduels x valeurs prédites. 

plot(modele_inv, 2) #Je demande la 2 figure Normal Q-Q
**Figure 6.14.** Graphique Q-Q des résiduels.

Figure 6.14. Graphique Q-Q des résiduels.

Réponse: Normalité est pire; homoscédasticité est pire aussi,variance augmente clairement avec augmentation des valeurs prédites.

  1. La racine carrée de WPC
  1. Normalité des résiduels ?
  2. Homoscédasticité ?
#Je génère le modèle pour sqr_wpc
modele_sqr<-lm(data=daisy2_mod, sqr_wpc ~ (dyst*par_ct + herd_size_ct + herd_size_ct_sq + twin))

plot(modele_sqr, 1) #Je demande la la figure Residual vs Fitted
**Figure 6.15.** Graphique des résiduels x valeurs prédites.

Figure 6.15. Graphique des résiduels x valeurs prédites. 

plot(modele_sqr, 2) #Je demande la 2 figure Normal Q-Q
**Figure 6.16.** Graphique Q-Q des résiduels.

Figure 6.16. Graphique Q-Q des résiduels.

Réponse: Normalité des résiduels est un peu mieux que WPC mais encore problématique (ln_wpc était meilleur de ce côté). L’homoscédasticité est beaucoup mieux. Peut-être même un peu mieux que ln_wpc sur cet aspect.

3) Outre l’amélioration des suppositions du modèle, est-ce que la transformation par le logarithme naturel pourrait vous offrir d’autres avantages comparativement, par exemple, à la transformation par la racine carrée?

Réponse: Oui, côté interprétation ce sera plus facile parce que nous pourrons directement retransformer et plus facilement interpréter l’estimé (i.e. l’exposant de \(β_1\)) et son IC 95%. Par exemple, avec le \(β\) de dyst (et IC 95%) de 0.027 (-0.163, 0.218) nous obtiendrons des valeurs retransformées de 1.03 (0.85, 1.24). Nous pourrons interpréter ces valeurs comme suit : WPC est multiplié par un facteur de 1.03 lorsque dystocie est présente, et nous avons 95% de certitude que la vraie valeur se situe entre une multiplication par 0.85 (i.e. une diminution du nombre de jours) et une multiplication par 1.24.

4) Vous décidez donc de continuer à travailler avec le logarithme naturel de WPC. Rappelez-vous que lorsque vous aviez évalué la relation entre herd_size et WPC, cette relation semblait curvilinéaire. Est-ce que cela implique que la relation entre herd_size et le logarithme naturel de WPC est également curvilinéaire ?

Réponse: Pas nécessairement, ln_wpc est une variable différente.

5) Évaluez graphiquement et à l’aide de termes quadratique et cubique la relation entre herd_size et le logarithme naturel de WPC. Avez-vous besoin d’inclure un terme au carré ? Un terme au cube ?

library(ggplot2)
ggplot(daisy2_mod, aes(herd_size, ln_wpc)) + 
  geom_point() +  
  geom_smooth(method="loess", span=2)+ 
  theme_bw()
**Figure 6.17.** Relation entre taille de troupeau (herd_size) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Figure 6.17. Relation entre taille de troupeau (herd_size) et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Réponse: Graphiquement, la relation avec ln_wpc semble aussi curvilinéaire.

#Je génère le modèle avec le terme au carré
modele_log2<-lm(data=daisy2_mod, ln_wpc ~ (herd_size_ct + herd_size_ct_sq))
summary(modele_log2)
## 
## Call:
## lm(formula = ln_wpc ~ (herd_size_ct + herd_size_ct_sq), data = daisy2_mod)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9279 -0.5420 -0.0283  0.5442  1.7717 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     3.881e+00  2.568e-02 151.147  < 2e-16 ***
## herd_size_ct    3.357e-03  3.145e-04  10.676  < 2e-16 ***
## herd_size_ct_sq 1.922e-05  4.564e-06   4.212 2.68e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7402 on 1571 degrees of freedom
##   (402 observations deleted due to missingness)
## Multiple R-squared:  0.06839,    Adjusted R-squared:  0.06721 
## F-statistic: 57.67 on 2 and 1571 DF,  p-value: < 2.2e-16

Réponse: Aussi, le terme au carré est significatif (P < 0.001), cela confirme la relation curvilinéaire.

#Je genère la variable au cube
daisy2_mod$herd_size_ct_cu <-daisy2_mod$herd_size_ct*daisy2_mod$herd_size_ct*daisy2_mod$herd_size_ct
#Je génère le modèle avec le terme au cube
modele_log3<-lm(data=daisy2_mod, ln_wpc ~ (herd_size_ct + herd_size_ct_sq + herd_size_ct_cu))
summary(modele_log3)
## 
## Call:
## lm(formula = ln_wpc ~ (herd_size_ct + herd_size_ct_sq + herd_size_ct_cu), 
##     data = daisy2_mod)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9243 -0.5377 -0.0293  0.5416  1.7768 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     3.879e+00  2.754e-02 140.868  < 2e-16 ***
## herd_size_ct    3.230e-03  6.862e-04   4.707 2.73e-06 ***
## herd_size_ct_sq 2.012e-05  6.254e-06   3.217  0.00132 ** 
## herd_size_ct_cu 1.687e-08  8.074e-08   0.209  0.83452    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7404 on 1570 degrees of freedom
##   (402 observations deleted due to missingness)
## Multiple R-squared:  0.06842,    Adjusted R-squared:  0.06664 
## F-statistic: 38.44 on 3 and 1570 DF,  p-value: < 2.2e-16

Réponse: Par contre le terme au cube n’est pas nécessaire (P=0.83) je pourrais l’enlever du modèle.

6) Dans votre modèle avec le logarithme naturel de WPC, et herd_size modélisé avec les termes polynomiaux appropriés, est-ce que l’interaction entre dyst et parity est toujours statistiquement significative ?

#Je génère le modèle pour log_wpc
modele_log<-lm(data=daisy2_mod, ln_wpc ~ (dyst*par_ct + herd_size_ct + herd_size_ct_sq + twin))
summary(modele_log)
## 
## Call:
## lm(formula = ln_wpc ~ (dyst * par_ct + herd_size_ct + herd_size_ct_sq + 
##     twin), data = daisy2_mod)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9054 -0.5348 -0.0242  0.5413  1.7691 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     3.851e+00  3.446e-02 111.734  < 2e-16 ***
## dyst            2.747e-02  9.715e-02   0.283  0.77735    
## par_ct          6.599e-03  1.292e-02   0.511  0.60960    
## herd_size_ct    3.438e-03  3.163e-04  10.872  < 2e-16 ***
## herd_size_ct_sq 2.029e-05  4.580e-06   4.430 1.01e-05 ***
## twin            4.577e-01  1.438e-01   3.184  0.00148 ** 
## dyst:par_ct     1.031e-01  6.160e-02   1.673  0.09449 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7373 on 1567 degrees of freedom
##   (402 observations deleted due to missingness)
## Multiple R-squared:  0.07782,    Adjusted R-squared:  0.07429 
## F-statistic: 22.04 on 6 and 1567 DF,  p-value: < 2.2e-16

Réponse: Non, P =0.0945

7) Si l’interaction n’est plus statistiquement significative cela signifie que:

  1. L’effet de dystocie ne varie pas en fonction de la parité
  2. Le terme d’interaction n’est pas nécessaire dans le modèle
  3. Le coefficient de régression pour le terme d’interaction n’est pas différent de zéro
  4. Toutes ces réponses

Réponse: d. Toutes ces réponses.

8) Comme vous avez pu le noter, transformer la variable dépendante vous oblige à revoir pratiquement tout votre modèle de A à Z. Mais bon, votre modèle final pourrait donc être :

\(log(wpc) = β_0 +β_1dyst + β_2parity_c + β_3herdsize _c + β_4herdsize_c^2 + β_5twin\)

Évaluez une dernière fois les suppositions de normalité des résiduels et d’homoscédasticité (puisque vous ne l’avez pas encore fait pour ce modèle sans l’interaction \(dyst*parity\)) et calculez dans une nouvelle table les valeurs prédites, les résiduels de Student, les leviers et les distances de Cook.

#Générons le modèle sans l'interaction
modele_final<-lm(data=daisy2_mod, ln_wpc ~ (dyst + par_ct + herd_size_ct + herd_size_ct_sq + twin))
summary(modele_final)
## 
## Call:
## lm(formula = ln_wpc ~ (dyst + par_ct + herd_size_ct + herd_size_ct_sq + 
##     twin), data = daisy2_mod)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9017 -0.5355 -0.0242  0.5342  1.7585 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     3.842e+00  3.413e-02 112.583  < 2e-16 ***
## dyst            1.196e-01  8.008e-02   1.494  0.13548    
## par_ct          1.112e-02  1.264e-02   0.880  0.37911    
## herd_size_ct    3.440e-03  3.164e-04  10.870  < 2e-16 ***
## herd_size_ct_sq 2.035e-05  4.582e-06   4.441 9.58e-06 ***
## twin            4.523e-01  1.438e-01   3.145  0.00169 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7378 on 1568 degrees of freedom
##   (402 observations deleted due to missingness)
## Multiple R-squared:  0.07617,    Adjusted R-squared:  0.07323 
## F-statistic: 25.86 on 5 and 1568 DF,  p-value: < 2.2e-16
#Vérifions d'abord les suppositions:
plot(modele_final, 2)
**Figure 6.18.** Graphique des résiduels x valeurs prédites.

Figure 6.18. Graphique des résiduels x valeurs prédites. 

plot(modele_final, 1)
**Figure 6.19.** Graphique Q-Q des résiduels.

Figure 6.19. Graphique Q-Q des résiduels.

Réponses: OK, les suppositions semblent respectées.

#Enregistrons les valeurs prédites, les résiduels de Student, les leviers et les distance de Cook
library(broom)
diag <- augment(modele_final) #Je viens de créer une nouvelle table dans laquelle les résiduels, distance de cook, etc se trouvent maintenant
  1. Combien d’observations ont des résiduels larges (résiduels de Student > 3.0 ou < -3.0)? Ont-elles quelque chose en commun en ce qui a trait à leurs valeurs de WPC, dyst, parity, herd_size ou twin?
#Je pourrais maintenant filtrer cette table pour ne conserver que les résiduels standardisés larges
diag_res <- subset(diag, (.std.resid >=3.0 | .std.resid<=-3.0))
diag_res
## # A tibble: 5 x 13
##   .rownames ln_wpc  dyst par_ct herd_size_ct herd_size_ct_sq  twin .fitted
##   <chr>      <dbl> <int>  <dbl>        <dbl>           <dbl> <int>   <dbl>
## 1 445         1.10     0      3          -15             225     0    3.83
## 2 1091        1.39     0      3          -49            2401     0    3.76
## 3 1144        0        0      1          -49            2401     0    3.73
## 4 1177        1.39     0      0          -49            2401     0    3.72
## 5 2500        0        0      1           13             169     0    3.90
## # ... with 5 more variables: .resid <dbl>, .hat <dbl>, .sigma <dbl>,
## #   .cooksd <dbl>, .std.resid <dbl>

Réponse: 5 observations ont des résiduels larges. Elles ont toutes des WPC très courts (i.e. des log_wpc près de 0 ou 1), pas de jumeaux (twin=0) et pas de dystocie (dyst=0).

  1. Vous pourriez représenter graphiquement les résiduels de Student en fonction de WPC pour mieux visualiser où se situent ses résiduels larges. Quel genre d’observations (en termes de WPC) le modèle semble avoir de la difficulté à prédire?
library(ggplot2)
ggplot(data=diag, aes(ln_wpc, .std.resid, colour=.std.resid)) + 
  geom_point() +  
  theme_bw()+
  geom_hline (aes(yintercept=3)) + 
  geom_hline (aes(yintercept=-3))
**Figure 6.20.** Relation entre résiduels standardisés et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Figure 6.20. Relation entre résiduels standardisés et le nombre de jours jusqu’à la saillie fécondante (wpc) avec courbe lissée avec un facteur de 2.

Réponse: Le modèle semble avoir de la difficulté à prédire les vaches avec log_WPC très courts.

  1. Évaluez maintenant les 5 ou 10 observations avec les leviers les plus élevés. Encore une fois, ont-elles quelque chose en commun?
#Je pourrais maintenant ordonner cette table pour voir les 10 observations avec les leviers les plus larges
diag_hat <- diag[order(-diag$.hat),]
head(diag_hat, 10)
## # A tibble: 10 x 13
##    .rownames ln_wpc  dyst par_ct herd_size_ct herd_size_ct_sq  twin .fitted
##    <chr>      <dbl> <int>  <dbl>        <dbl>           <dbl> <int>   <dbl>
##  1 48          4.60     1      1           44            1936     1    4.62
##  2 5628        3.14     1      0          -65            4225     1    4.28
##  3 1148        3.47     1      1          -49            2401     1    4.31
##  4 1363        4.36     0      2         -125           15625     1    4.20
##  5 791         3.64     0      4           83            6889     1    4.76
##  6 313         4.79     0      0           44            1936     1    4.49
##  7 377         5.15     0      5          -15             225     1    4.30
##  8 2627        3.97     0      5           13             169     1    4.40
##  9 2628        4.66     0      5           13             169     1    4.40
## 10 2513        4.70     0      0           13             169     1    4.34
## # ... with 5 more variables: .resid <dbl>, .hat <dbl>, .sigma <dbl>,
## #   .cooksd <dbl>, .std.resid <dbl>

Réponse: Ces vaches ont toutes eu des jumeaux.

  1. Les observations avec des résiduels ou des leviers larges (ou les deux) sont des observations qui peuvent potentiellement influencer le modèle de régression. Les distances de Cook nous permettrons d’identifier quelles observations avaient effectivement une influence sur le modèle. Évaluez donc maintenant les 5 ou 10 observations avec les distances de Cook les plus élevées. Ont-elles quelque chose en commun ?
#Je pourrais maintenant ordonner cette table pour voir les 10 observations avec les distance de Cook les plus larges
diag_cook <- diag[order(-diag$.cooksd),]
head(diag_cook, 10)
## # A tibble: 10 x 13
##    .rownames ln_wpc  dyst par_ct herd_size_ct herd_size_ct_sq  twin .fitted
##    <chr>      <dbl> <int>  <dbl>        <dbl>           <dbl> <int>   <dbl>
##  1 491         2.64     0      2          -15             225     1    4.27
##  2 5628        3.14     1      0          -65            4225     1    4.28
##  3 791         3.64     0      4           83            6889     1    4.76
##  4 1148        3.47     1      1          -49            2401     1    4.31
##  5 1239        5.45     1      4          -49            2401     0    3.89
##  6 1230        5.53     1      3          -49            2401     0    3.88
##  7 5527        5.48     1      3          -65            4225     0    3.86
##  8 377         5.15     0      5          -15             225     1    4.30
##  9 2543        2.40     1      0           13             169     0    4.01
## 10 2753        2.40     1      1           13             169     0    4.02
## # ... with 5 more variables: .resid <dbl>, .hat <dbl>, .sigma <dbl>,
## #   .cooksd <dbl>, .std.resid <dbl>

Réponse: Les vaches qui ont eu des jumeaux sont les pires. Les log_WPC courts (i.e. résiduels larges) ne semble pas influencer beaucoup le modèle.

  1. Vérifiez maintenant jusqu’à quel point ces observations influencent vos résultats en calculant de nouveau votre modèle mais sans les observations avec les distance de Cook les plus élevées (e.g. les 7 observations avec les distances de Cook > 0.010).
#Je génère un jeu de données sans les 7 observations avec les distances de Cook les plus grandes
outlier <- subset(diag, .cooksd<0.01)
#Je refais le modèle sur ce jeu de données réduit
modele_outlier<-lm(data=outlier, ln_wpc ~ (dyst + par_ct + herd_size_ct + herd_size_ct_sq + twin))
summary(modele_outlier)
## 
## Call:
## lm(formula = ln_wpc ~ (dyst + par_ct + herd_size_ct + herd_size_ct_sq + 
##     twin), data = outlier)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9025 -0.5359 -0.0304  0.5329  1.7697 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     3.847e+00  3.397e-02 113.257  < 2e-16 ***
## dyst            8.378e-02  8.160e-02   1.027    0.305    
## par_ct          6.913e-03  1.260e-02   0.548    0.583    
## herd_size_ct    3.485e-03  3.148e-04  11.070  < 2e-16 ***
## herd_size_ct_sq 2.079e-05  4.557e-06   4.562 5.46e-06 ***
## twin            6.656e-01  1.546e-01   4.306 1.77e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7329 on 1561 degrees of freedom
## Multiple R-squared:  0.0826, Adjusted R-squared:  0.07966 
## F-statistic: 28.11 on 5 and 1561 DF,  p-value: < 2.2e-16

Est-ce que les conclusions des tests de F ou de T changent comparativement au modèle calculé au début de la question 8?

Réponse: Les valeurs de P changent un peu mais aucune des conclusions n’est modifiée.

Est-ce que les estimés obtenus changent beaucoup ? Pour quel paramètre l’estimé semble être le plus affecté ? Est-ce en accord avec votre réponse à la question 8.d. ?

Réponse: Les estimés ne changent pas beaucoup. Le paramètre qui semble être le plus affecté est twin. Ce dernier passe de +0.45 log_wpc à +0.66 log_wpc lorsque les observations influentes sont retirées. C’est bien certainement en accord avec le fait que les observations les plus influentes sont des observations où twin=1.

6.12 Travaux pratiques 3 - Régression linéaire - Construction de modèle

6.12.1 Exercices

Les données utilisées pour ce TP sont obtenues à partir de la page du cours sur Studium. La base de données milk2 est disponible en format ASCII délimité (.csv).

Le jeu de données milk2 comprend 5 variables et 1140 observations:

breed race de la vache (1 = Ayrshire, 2 = Holstein, 3 = Jersey, 8 =mixed)
parity numéro de lactation
kgmilk production journalière de lait en kg
cellcount comptage en cellules somatiques x 10^3 cell./ml de lait
cowid identification de la vache

Vous êtes intéressé à savoir quel est l’effet de la production laitière sur le comptage des cellules somatiques. Votre diagramme causal est le suivant:

Figure 6.21. Diagramme causal de la relation entre production laitière et comptage des cellules somatiques.

À partir du jeu de données fourni (milk2), répondre aux questions suivantes :

  1. Quels sont les variables confondantes que vous devrez possiblement contrôler pour répondre à votre question de recherche?

  2. Quel serait votre modèle maximum ?

  3. Quelles sont les étapes que vous aurez à réaliser afin de développer et évaluer ce modèle statistique ?

Évidemment, ce serait difficile de tout faire cela dans un TP de 3hrs. Dans les questions suivantes, vous n’aurez qu’à évaluer certains aspects de ce travail.

  1. Que pensez-vous de la variable cellcount (données manquantes, distribution)? Pensez-vous que cette variable causera des problèmes plus tard? Si oui, que pourriez-vous faire ?

  2. Évaluez la variable parity. Peu de vaches ont eu 5, 6, 7 ou 8 lactations. Pensez-vous qu’il serait préférable de catégoriser cette variable (e.g. 1ère vs. 2ième vs. 3ième vs. 4ième vs. > 4ième)?

  3. À propose de la relation entre kgmilk et cellcount :

    6.1. Comment se comportent les résiduels (normalité et homoscédasticité) dans un model simple:
    \(cellcount=β_0 + β_1*kgmilk\) ?
    Et avec \(log(cellcount)=β_0 + β_1*kgmilk\)?

    Comme noté à la question 4, il semble qu’il serait mieux de travailler avec le logarithme naturel de cellcount qu’avec la variable originale. Continuez donc avec le log(cellcount) pour les analyses suivantes.

    6.2. Comment est-ce que log(cellcount) varie en fonction de kgmilk? Est-ce que cette relation est linéaire? Comment allez-vous modéliser cette relation dans vos analyses subséquentes?

  4. Associations conditionnelles.

    7.1. La relation entre parity et cellcount également n’était pas linéaire et vous devrez donc modéliser cette relation à l’aide de 2 termes : \(parity centrée\) et \(parity centrée^2\). Trouvez-vous que les coefficients pour la production laitière changent beaucoup lorsqu’on ajuste pour le facteur confondant parité ?
    i.e. le modèle:
    \(log(cellcount)=β_0 + β_1*kgmilk centré + β_2*kgmilk centré^2 + β_3*kgmilk centré^3 + β_4*parity centrée + β_5*parity centrée^2\)

    7.2. Trouvez-vous que les coefficients pour la production laitière changent beaucoup lorsqu’on ajuste pour race?

  5. Afin de réduire votre modèle maximum, vous décidez de retirer du modèle les facteurs confondants hypothétique qui causaient une modification relative < 10% de la mesure d’effet de kgmilk. Quel(s) facteurs confondant gardez-vous? Y-a-t’il d’autre variables que vous désirez maintenant retirer du modèle? Quel serait votre modèle final?

  6. Évaluez si les suppositions de votre modèle final sont respectées.

  7. Évaluez les observations extrêmes, leviers et influentes (nombre, profil commun).
    10.1. Quelle est la valeur de cellcount pour les observations avec les résiduels négatifs les plus larges?
    10.2. Une valeur de 1,000 cell./ml est assez inusitée pour un comptage des cellules somatiques. En fait la limite analytique du Fossomatic cell counter est généralement de 10,000 cell./ml. Vous appellez donc le laboratoire pour en savoir plus sur ces résultats. On vous dit qu’on donne la valeur « 1 » aux échantillons qui ne peuvent être analysés (échapé, mal conservé, etc). Il s’agit donc d’observations manquantes! Vous pouvez donc ré-évaluer le modèle en excluant ces observations (et en priant pour que les résultats changent peu).
    Notez comment votre Q-Q plot et l’histogramme des résiduels sont encore mieux sans ces observations. Combien d’observations avec un résiduel large (>3 ou <-3) avez-vous? Ces observations ont-elles quelquechose en commun?
    10.3. Vérifiez maintenant les 10 observations avec les leviers les plus grands. Ont-elles quelquechose en commun?
    10.4. Vérifiez maintenant les 10 observations les plus influentes. Ont-elles quelquechose en commun?

  8. Présentation des résultats.
    11.1. Présentez les résultats de votre modèle dans une table que vous pourriez soumettre dans une publication scientifique.
    L’effet de la production laitière n’est plus sur l’échelle originale. En plus, la relation entre production et CCS n’est pas linéaire. Tout ça rend votre modèle difficile à interpréter et il faudrait possiblement trouver une manière de rendre l’information plus digestible pour vos lecteurs.
    11.2. Vous pourriez présenter comment le CCS varie en fonction de la production laitière pour différents scénarios. Vous pourriez, par exemple, compléter la table suivante, en calculant la valeur prédite pour chaque scénario à l’aide de votre modèle, puis en retransformant ces valeurs sur l’échelle originale:

Table 6.3. Valeurs prédites de comptage des cellules somatiques (CCS) du lait (x1000 cell./ml) d’une vache Ayrshire pour différentes combinaisons de production et parité.
Production 1ère lactation 2ième lactation 3ième et plus
10kg/jour
20kg/jour
30kg/jour

11.3. Encore mieux : à partir d’une table R contenant les valeurs prédites, retransformez la valeur prédite sur l’échelle originale en créant une nouvelle variable \(CCS=exp(valeur prédite)\). Ensuite, vous pourrez utiliser le package ggplot2 pour représenter dans un graphique nuage de points la relation entre la production laitière (en x) et la valeur prédite de CCS (en y).
C’est plus simple à comprendre ainsi n’est-ce pas?

6.12.2 Code R et réponses

Les données utilisées pour ce TP sont obtenues à partir de la page du cours sur Studium. La base de données milk2 est disponible en format ASCII délimité (.csv).

#J'ouvre le jeu de données
milk2 <-read.csv(file="milk2.csv", header=TRUE, sep=";")

  1. Quels sont les variables confondantes que vous devrez possiblement contrôler pour répondre à votre question de recherche?
    Réponse: Parité et Race

  2. Quel serait votre modèle maximum ?
    Réponse: \(cellcount = β_0 + β_1*kgmilk + β_2*breed + β_3*parity\)

  3. Quelles sont les étapes que vous aurez à réaliser afin de développer et évaluer ce modèle statistique ?
    Réponse:

    1. Évaluer cellcount seul (données manquantes, distribution, transformation…)
    2. Évaluer individuellement kgmilk, breed et parity (données manquantes, distributions, table de fréquence, transformations pour centrer ou mettre à l’échelle, décider des catégories de référence…)
    3. Évaluer association inconditionnelle entre chaque prédicteur et cellcount (graphiques et modèles, linéarité de la relation pour les variables continues):
      Pour Kgmilk:
    • Nuage de points kgmilk x cellcount avec courbe loess pour linéarité
    • Modèle \(cellcount = β_0 + β_1*kgmilk\)
    • Modèle \(cellcount = β_0 + β_1*kgmilk + β_2*kgmilk^2\) (pour évaluer forme de la relation)
    • Modèle \(cellcount = β_0 + β_1*kgmilk + β_2*kgmilk^2 + kgmilk^3\) (pour évaluer forme de la relation)
      Pour Breed:
    • Box-plot cellcount x breed
    • Modèle \(cellcount = β_0 + β_1*breed\)
      Pour Parity:
    • Nuage de points avec loess ou box-plot cellcount x parity pour linéarité
    • Modèle \(cellcount = β_0 + β_1*parity\)
    • Modèle \(cellcount = β_0 + β_1*parity + β_2*parity^2\) (pour évaluer forme de la relation)
    • Modèle \(cellcount = β_0 + β_1*parity + β_2*parity^2 + parity^3\) (pour évaluer forme de la relation)
    1. Évaluer associations inconditionnelle entre prédicteurs
      Pour Kgmilk et breed:
    • Boxplot kgmilk x breed
    • Modèle \(kgmilk=β_0 + β_1*breed\)
      Pour Parity et breed:
    • Boxplot parity x breed
    • Modèle \(parity=β_0 + β_1*breed\)
      Pour Kgmilk et parity:
    • Nuage de points kgmilk x parity avec courbe loess
    • Modèle \(kgmilk=β_0 + β_1*parity\)
    1. Évaluer associations conditionnelles (i.e. après avoir ajouté un confondant):
      Breed (confondant)
    • Modèle \(cellcount=β_0 + β_1*kgmilk + β_2*breed\)
      Parity (confondant)
    • Modèle \(cellcount=β_0 + β_1*kgmilk + β_2*Parity\)
      Notez : s’il y avait eu une interaction à investiguer, c’est à ce stade-ci que vous auriez pu évaluer le modèle avec juste l’interaction. Par exemple: \(cellcount= β_0 + β_1*kgmilk + β_2*parity + β_3*kgmilk*parity\)
    1. Établir une stratégie de sélection des covariables qui permettra de réduire le modèle maximum
      Confondants : par exemple on peut choisir de réduire le nombre de facteurs confondants en vérifiant si association conditionnelle et inconditionnelle diffèrent par plus de 10%
      Notez : s’il y avait eu une interaction à investiguer, c’est à ce stade-ci que vous auriez pu spécifier quels critères seront utilisés pour décider des interactions à retenir. Par exemple : si terme(s) d’interaction à une valeur de P < 0.05, alors garder l’interaction et les termes principaux.
    2. Évaluer le modèle
      Suppositions (homoscédasticité et normalité)
      Observations:
    • Extrêmes (résiduels)
    • Combinaisons de prédicteurs (leviers)
    • Influentes (Cook’s distance)

Évidemment, ce serait difficile de tout faire cela dans un TP de 3hrs. Dans les questions suivantes, vous n’aurez qu’à évaluer certains aspects de ce travail.

  1. Que pensez-vous de la variable cellcount (données manquantes, distribution)? Pensez-vous que cette variable causera des problèmes plus tard? Si oui, que pourriez-vous faire ?
#J'aime beaucoup le package summarytools pour les analyses descriptives. Ici j'ai demandé les stats descriptives pour toute les variables de milk2.
#J'aurais aussi pu spécifier milk2$cellcount pour ne voir que cellcount.
#Dans mon cas, comme je travaille avec RMarkdown, j'ai du spécifier method='render'. Cet argument n'est pas nécessaire sinon.
library(summarytools)
print(dfSummary(milk2), method='render')

Data Frame Summary

milk2

Dimensions: 1140 x 5
Duplicates: 54
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 breed [integer] Mean (sd) : 3.4 (2.6) min < med < max: 1 < 2 < 8 IQR (CV) : 1 (0.8)
1:161(14.1%)
2:518(45.4%)
3:196(17.2%)
8:265(23.2%)
 1140 (100.0%) 0 (0.0%)
2 parity [integer] Mean (sd) : 2.3 (1.4) min < med < max: 1 < 2 < 8 IQR (CV) : 2 (0.6)
1:421(37.0%)
2:311(27.3%)
3:200(17.6%)
4:125(11.0%)
5:45(4.0%)
6:27(2.4%)
7:5(0.4%)
8:5(0.4%)
 1139 (99.9%) 1 (0.1%)
3 kgmilk [numeric] Mean (sd) : 19.9 (6.5) min < med < max: 3.2 < 19.6 < 43.1 IQR (CV) : 8.3 (0.3) 269 distinct values 1140 (100.0%) 0 (0.0%)
4 cellcount [integer] Mean (sd) : 369.9 (739.8) min < med < max: 1 < 138 < 8100 IQR (CV) : 305 (2) 422 distinct values 1140 (100.0%) 0 (0.0%)
5 cowid [integer] Mean (sd) : 227807355 (155552851) min < med < max: 25930370 < 117880788 < 455261650 IQR (CV) : 271260050 (0.7) 1086 distinct values 1140 (100.0%) 0 (0.0%)

Generated by summarytools 0.9.8 (R version 4.0.4)
2022-02-11

Réponse: Pour cellcount, il n’y a pas de données manquantes, la distribution est skewed à droite. Oui, les résiduels seront probablement skewed aussi. Je pourrais déjà vérifier si une transformation (par exemple un log naturel) améliorerait sa distribution :

milk2$log_cell <- log(milk2$cellcount)
print(dfSummary(milk2$log_cell), method='render')
## milk2$log_cell was converted to a data frame

Data Frame Summary

milk2

Dimensions: 1140 x 1
Duplicates: 718
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 log_cell [numeric] Mean (sd) : 5 (1.4) min < med < max: 0 < 4.9 < 9 IQR (CV) : 1.9 (0.3) 422 distinct values 1140 (100.0%) 0 (0.0%)

Generated by summarytools 0.9.8 (R version 4.0.4)
2022-02-11

  1. Évaluez la variable parity. Peu de vaches ont eu 5, 6, 7 ou 8 lactations. Pensez-vous qu’il serait préférable de catégoriser cette variable (e.g. 1ère vs. 2ième vs. 3ième vs. 4ième vs. > 4ième)?

Réponse: Voir mes résultats descriptifs précédents. Non, parce qu’elle est utilisée comme facteur confondant. Je préfère donc conserver la mesure la plus précise possible afin d’avoir le meilleur contrôle possible. S’il s’agissait d’une exposition, nous pourrions effectivement considérer cette catégorisation.

  1. À propose de la relation entre kgmilk et cellcount :

    6.1. Comment se comportent les résiduels (normalité et homoscédasticité) dans un model simple:
    \(cellcount=β_0 + β_1*kgmilk\) ?
    Et avec \(log(cellcount)=β_0 + β_1*kgmilk\)?

#Le modèle avec cellcount et les figures de Dx des résiduels
model_cellcount <- lm(data=milk2, cellcount ~ kgmilk)
plot(model_cellcount, 1)
**Figure 6.22.** Graphiques des résiduels x valeurs prédites.

Figure 6.22. Graphiques des résiduels x valeurs prédites. 

plot(model_cellcount, 2)
**Figure 6.23.** Graphiques Q-Q des résiduels.

Figure 6.23. Graphiques Q-Q des résiduels.

Réponse: Problème de normalité et possiblement homoscédasticité!

#Le modèle avec le logarithme de cellcount et les figures de Dx des résiduels
model_log_cell <- lm(data=milk2, log_cell ~ kgmilk)
plot(model_log_cell, 1)
**Figure 6.24.** Graphiques des résiduels x valeurs prédites.

Figure 6.24. Graphiques des résiduels x valeurs prédites. 

plot(model_log_cell, 2)
**Figure 6.25.** Graphiques Q-Q des résiduels.

Figure 6.25. Graphiques Q-Q des résiduels.

Réponse: Dans le modèle avec le logarithme naturel de cellcount c’est beaucoup mieux.

Comme noté à la question 4, il semble qu’il serait mieux de travailler avec le logarithme naturel de cellcount qu’avec la variable originale. Continuez donc avec le log(cellcount) pour les analyses suivantes.

6.2. Comment est-ce que log(cellcount) varie en fonction de kgmilk? Est-ce que cette relation est linéaire? Comment allez-vous modéliser cette relation dans vos analyses subséquentes?

library(ggplot2)
ggplot(milk2, aes(kgmilk, log_cell)) + 
  geom_point() +  #
  geom_smooth(method="loess", span=2)+  
  theme_bw()
**Figure 6.26.** Relation entre la production laitière (en kg/j) et le logarithme naturel de cellcount avec courbe lissée avec un facteur de 2.

Figure 6.26. Relation entre la production laitière (en kg/j) et le logarithme naturel de cellcount avec courbe lissée avec un facteur de 2.

Réponse: Le logarithme de cellcount diminue avec la production puis augmente (i.e. une courbe). La relation n’est pas linéaire. Vérifions avec les termes polynomiaux…

#D'abord, centrons kgmilk sur une valeur près de la moyenne (pour éviter la colinéarité)
milk2$kgmilk_ct <- milk2$kgmilk-20
#Puis créons des terme au carré et au cube
milk2$kgmilk_ct_sq <- milk2$kgmilk_ct*milk2$kgmilk_ct 
milk2$kgmilk_ct_cu <- milk2$kgmilk_ct*milk2$kgmilk_ct*milk2$kgmilk_ct
#Vérifions le modèle avec le terme au carré
model_sq <- lm(data=milk2, log_cell ~ (kgmilk_ct + kgmilk_ct_sq))
summary(model_sq)
## 
## Call:
## lm(formula = log_cell ~ (kgmilk_ct + kgmilk_ct_sq), data = milk2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.9196 -0.9167 -0.0497  0.8787  4.2372 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   4.8028594  0.0491544  97.710  < 2e-16 ***
## kgmilk_ct    -0.0281185  0.0064195  -4.380 1.30e-05 ***
## kgmilk_ct_sq  0.0035949  0.0006477   5.551 3.54e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.376 on 1137 degrees of freedom
## Multiple R-squared:  0.03517,    Adjusted R-squared:  0.03347 
## F-statistic: 20.72 on 2 and 1137 DF,  p-value: 1.448e-09

Réponse: Le terme au carré est significatif (P < 0.05)

#Vérifions le modèle avec le terme au carré et le terme au cube
model_cu <- lm(data=milk2, log_cell ~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu))
summary(model_cu)
## 
## Call:
## lm(formula = log_cell ~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu), 
##     data = milk2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.8668 -0.9016 -0.0672  0.8875  4.2224 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   4.787e+00  4.974e-02  96.235  < 2e-16 ***
## kgmilk_ct    -1.282e-02  1.007e-02  -1.273   0.2031    
## kgmilk_ct_sq  4.236e-03  7.241e-04   5.850 6.41e-09 ***
## kgmilk_ct_cu -1.185e-04  6.014e-05  -1.970   0.0491 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.375 on 1136 degrees of freedom
## Multiple R-squared:  0.03845,    Adjusted R-squared:  0.03591 
## F-statistic: 15.14 on 3 and 1136 DF,  p-value: 1.145e-09

Réponse: Le terme au cube est aussi significatif (P < 0.05). Cette relation devrait donc être modélisée en utilisant \(kgmilkcentré + kgmilkcentré^2 + kgmilk centré^3\)

  1. Associations conditionnelles.

    7.1. La relation entre parity et cellcount également n’était pas linéaire et vous devrez donc modéliser cette relation à l’aide de 2 termes : \(parity centrée\) et \(parity centrée^2\). Trouvez-vous que les coefficients pour la production laitière changent beaucoup lorsqu’on ajuste pour le facteur confondant parité ?
    i.e. le modèle:
    \(log(cellcount)=β_0 + β_1*kgmilk centré + + β_2*kgmilk centré^2 + β_3*kgmilk centré^3 + β_4*parity centrée + β_5*parity centrée^2\)

#Générons ces nouvelles variables parité centrée sur parité 1
milk2$parity_ct <- milk2$parity-1
milk2$parity_ct_sq <- milk2$parity_ct*milk2$parity_ct
#Vérifions les modèles avec et sans ajustement pour parity (j'ai déjà fait rouler celui sans parity à la question 6.2)
model_parity <- lm(data=milk2, log_cell~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu + parity_ct + parity_ct_sq))
summary(model_parity)
## 
## Call:
## lm(formula = log_cell ~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu + 
##     parity_ct + parity_ct_sq), data = milk2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.2194 -0.8303 -0.0055  0.8096  4.1204 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   4.383e+00  6.476e-02  67.679  < 2e-16 ***
## kgmilk_ct    -3.452e-02  9.947e-03  -3.471 0.000539 ***
## kgmilk_ct_sq  2.985e-03  7.087e-04   4.212 2.73e-05 ***
## kgmilk_ct_cu -6.589e-05  5.816e-05  -1.133 0.257514    
## parity_ct     5.102e-01  7.125e-02   7.161 1.44e-12 ***
## parity_ct_sq -5.742e-02  1.514e-02  -3.794 0.000156 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.323 on 1133 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.1114, Adjusted R-squared:  0.1075 
## F-statistic: 28.41 on 5 and 1133 DF,  p-value: < 2.2e-16

Réponse: Oui voir table suivante (notez que j’ai arrondi les estimés avant de faire les calculs). Notez aussi, le \(kgmilk^3\) n’est plus significatif (P = 0.26) après avoir ajusté pour parité (i.e. \(kgmilk^3\) ne serait plus nécessaire après ajustement pour parité).

Table 6.4. Estimés de l’effet de la production laitière sans (inconditionelle) et avec (conditionelle) ajustement pour parity.
Inconditionnelle Conditionelle Diff_relative_parity
kgmilk_ct -0.0128 -0.0345 -170
kgmilk_ct_sq 0.0042 0.0030 29
kgmilk_ct_cu -0.0001 -0.0001 0

7.2. Trouvez-vous que les coefficients pour la production laitière changent beaucoup lorsqu’on ajuste pour race?

#Vérifions les modèles avec ajustement pour race
model_breed <- lm(data=milk2, log_cell~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu + factor(breed)))
summary(model_breed)
## 
## Call:
## lm(formula = log_cell ~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu + 
##     factor(breed)), data = milk2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.9882 -0.8871 -0.0977  0.8370  4.0193 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     4.853e+00  1.117e-01  43.433  < 2e-16 ***
## kgmilk_ct      -2.860e-02  1.026e-02  -2.787  0.00541 ** 
## kgmilk_ct_sq    3.754e-03  7.168e-04   5.237 1.94e-07 ***
## kgmilk_ct_cu   -7.864e-05  5.960e-05  -1.320  0.18726    
## factor(breed)2  1.880e-01  1.233e-01   1.524  0.12775    
## factor(breed)3 -5.860e-01  1.454e-01  -4.029 5.98e-05 ***
## factor(breed)8 -1.474e-01  1.361e-01  -1.083  0.27923    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.35 on 1133 degrees of freedom
## Multiple R-squared:  0.0749, Adjusted R-squared:   0.07 
## F-statistic: 15.29 on 6 and 1133 DF,  p-value: < 2.2e-16

Réponse: Notez que j’ai du indiquer que breed est une variable catégorique (parce que, dans la base de données, les catégories de races sont indiquées par des chiffres, ce qui peut laisser croire à R qu’il s’agit d’une variable quantitative). Voir la table suivante où je présente les estimés ajustés ou non pour breed.

Table 6.5. Estimés de l’effet de la production laitière sans (inconditionelle) et avec (conditionelle) ajustement pour breed.
Inconditionnelle Conditionelle Diff_relative_breed
kgmilk_ct -0.0128 -0.0286 -123
kgmilk_ct_sq 0.0042 0.0038 10
kgmilk_ct_cu -0.0001 -0.0001 0
  1. Afin de réduire votre modèle maximum, vous décidez de retirer du modèle les facteurs confondants hypothétique qui causaient une modification relative < 10% de la mesure d’effet de kgmilk. Quel(s) facteurs confondant gardez-vous? Y-a-t’il d’autre variables que vous désirez maintenant retirer du modèle? Quel serait votre modèle final?

Réponse: Parité et race seront inclus comme facteur confondant (i.e. \(paritycentrée + paritycentrée^2 + breed\)). Ces deux variables crééaient des changement importants (123 à 170% de différence relative) pour au moins un des termes kgmilk. Notez que l’ajout de point d’inflexion (i.e. \(kgmilk^3\)) n’est plus nécessaire maintenant (voir résultats plus bas). Ce terme pourrait être retiré.

model_max <- lm(data=milk2, log_cell~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu + parity_ct + parity_ct_sq + factor(breed)))
summary(model_max)
## 
## Call:
## lm(formula = log_cell ~ (kgmilk_ct + kgmilk_ct_sq + kgmilk_ct_cu + 
##     parity_ct + parity_ct_sq + factor(breed)), data = milk2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.3616 -0.8233 -0.0648  0.8125  4.1456 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     4.406e+00  1.146e-01  38.463  < 2e-16 ***
## kgmilk_ct      -5.924e-02  1.011e-02  -5.857 6.18e-09 ***
## kgmilk_ct_sq    2.260e-03  6.934e-04   3.259  0.00115 ** 
## kgmilk_ct_cu   -2.915e-06  5.701e-05  -0.051  0.95923    
## parity_ct       5.745e-01  6.950e-02   8.265 3.88e-16 ***
## parity_ct_sq   -6.241e-02  1.468e-02  -4.252 2.29e-05 ***
## factor(breed)2  2.043e-01  1.174e-01   1.741  0.08201 .  
## factor(breed)3 -7.932e-01  1.395e-01  -5.685 1.66e-08 ***
## factor(breed)8 -9.039e-02  1.296e-01  -0.697  0.48573    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.282 on 1130 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.1679, Adjusted R-squared:  0.162 
## F-statistic:  28.5 on 8 and 1130 DF,  p-value: < 2.2e-16

Le modèle final serait: \(Log(cellcount) = β_0 + β_1*kgmilk_ct + β_2*kgmilk_ct_sq + β_3*parity_ct + β_4*parity_ct_sq + β_5*breed\) et voici les résultats de ce modèle:

model_final <- lm(data=milk2, log_cell~ (kgmilk_ct + kgmilk_ct_sq + parity_ct + parity_ct_sq + factor(breed)))
summary(model_final)
## 
## Call:
## lm(formula = log_cell ~ (kgmilk_ct + kgmilk_ct_sq + parity_ct + 
##     parity_ct_sq + factor(breed)), data = milk2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -5.3612 -0.8246 -0.0672  0.8113  4.1447 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     4.406646   0.114237  38.574  < 2e-16 ***
## kgmilk_ct      -0.059636   0.006509  -9.161  < 2e-16 ***
## kgmilk_ct_sq    0.002244   0.000615   3.648 0.000276 ***
## parity_ct       0.574849   0.069058   8.324 2.43e-16 ***
## parity_ct_sq   -0.062466   0.014629  -4.270 2.12e-05 ***
## factor(breed)2  0.204097   0.117247   1.741 0.081999 .  
## factor(breed)3 -0.794119   0.138230  -5.745 1.18e-08 ***
## factor(breed)8 -0.090508   0.129543  -0.699 0.484900    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.281 on 1131 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.1679, Adjusted R-squared:  0.1628 
## F-statistic:  32.6 on 7 and 1131 DF,  p-value: < 2.2e-16
  1. Évaluez si les suppositions de votre modèle final sont respectées.

Réponse: Homoscédasticité semble OK (voir figure plus bas). Il ne semble pas y avoir d’augmentation ou de diminution flagrante de la variance des résiduels (à l’exception des extrémités, mais il y a très peu d’observations avec valeur prédite > 6).

plot(model_final, 1)
**Figure 6.26.** Graphiques des résiduels x valeurs prédites.

Figure 6.26. Graphiques des résiduels x valeurs prédites.

Réponse: Normalité des résiduels semble OK (voir figure plus bas). Il y a à peine une 30aine d’observations qui ne tombent pas sur la droite de 45 degré).

plot(model_final, 2)
**Figure 6.27.** Graphiques Q-Q des résiduels

Figure 6.27. Graphiques Q-Q des résiduels

  1. Évaluez les observations extrêmes, leviers et influentes (nombre, profil commun).
    10.1. Quelle est la valeur de cellcount pour les observations avec les résiduels négatifs les plus larges?
library(broom)
diag <- augment(model_final) #Je viens de créer une nouvelle table dans laquelle les résiduels, distance de cook, etc se trouvent maintenant
diag_res <- subset(diag, (.std.resid < -3.0)) #Gardons seulement les résiduels standardisés <-3.0
diag_res <- diag_res[order(-diag_res$.std.resid),] #Plaçons les résiduels en ordre décroissants
diag_res <- na.omit(diag_res) #Enlever les valeurs manquantes
Table 6.6. Observations avec les résiduels négatifs les plus larges.
.rownames log_cell kgmilk_ct kgmilk_ct_sq parity_ct parity_ct_sq factor(breed) .fitted .hat .sigma .cooksd .std.resid
107 0 2.4 5.76 1 1 3 3.994707 0.0069269 1.276052 0.0085374 -3.129175
114 0 2.1 4.41 1 1 3 4.009569 0.0068426 1.276011 0.0084950 -3.140684
100 0 -0.2 0.04 1 1 3 4.136926 0.0062477 1.275652 0.0082471 -3.239472
595 0 3.1 9.61 0 0 8 4.152829 0.0052622 1.275612 0.0069859 -3.250314
594 0 -0.3 0.09 0 0 8 4.334230 0.0048561 1.275078 0.0070164 -3.391600
155 0 2.0 4.00 2 4 3 4.402063 0.0070718 1.274856 0.0105873 -3.448521
785 0 2.0 4.00 2 4 3 4.402063 0.0070718 1.274856 0.0105873 -3.448521
151 0 -1.2 1.44 2 4 3 4.587153 0.0065241 1.274278 0.0105943 -3.592527
781 0 -1.2 1.44 2 4 3 4.587153 0.0065241 1.274278 0.0105943 -3.592527
113 0 -3.0 9.00 0 0 1 4.605745 0.0074727 1.274212 0.0122567 -3.608812
250 0 2.8 7.84 2 4 2 5.361186 0.0036766 1.271613 0.0081088 -4.192724

Réponse: le log(cellcount) est 0.0 (donc un cellcount de 1 x 1000 cellules/ml).

10.2. Une valeur de 1,000 cell./ml est assez inusitée pour un comptage des cellules somatiques. En fait la limite analytique du Fossomatic cell counter est généralement de 10,000 cell./ml. Vous appellez donc le laboratoire pour en savoir plus sur ces résultats. On vous dit qu’on donne la valeur « 1 » aux échantillons qui ne peuvent être analysés (échapé, mal conservé, etc). Il s’agit donc d’observations manquantes! Vous pouvez donc ré-évaluer le modèle en excluant ces observations (et en priant pour que les résultats changent peu).

milk2_corrected <- subset(milk2, milk2$cellcount>10)
milk2_corrected$breed <- factor(milk2_corrected$breed)
model_final2 <- lm(data=milk2_corrected, log_cell~ (kgmilk_ct + kgmilk_ct_sq + parity_ct + parity_ct_sq + breed))
summary(model_final2)
## 
## Call:
## lm(formula = log_cell ~ (kgmilk_ct + kgmilk_ct_sq + parity_ct + 
##     parity_ct_sq + breed), data = milk2_corrected)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.6932 -0.8179 -0.1134  0.7179  4.0391 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   4.5993247  0.1070076  42.981  < 2e-16 ***
## kgmilk_ct    -0.0472845  0.0060207  -7.854 9.61e-15 ***
## kgmilk_ct_sq  0.0014894  0.0005636   2.643  0.00834 ** 
## parity_ct     0.5513005  0.0638717   8.631  < 2e-16 ***
## parity_ct_sq -0.0595009  0.0135340  -4.396 1.21e-05 ***
## breed2        0.0759856  0.1090067   0.697  0.48591    
## breed3       -0.6004440  0.1300708  -4.616 4.37e-06 ***
## breed8       -0.1529191  0.1207002  -1.267  0.20545    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.168 on 1093 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.1512, Adjusted R-squared:  0.1458 
## F-statistic: 27.81 on 7 and 1093 DF,  p-value: < 2.2e-16
plot(model_final2, 1)
**Figure 6.27.** Graphiques des résiduels x valeurs prédites.

Figure 6.27. Graphiques des résiduels x valeurs prédites. 

plot(model_final2, 2)
**Figure 6.28.** Graphiques Q-Q des résiduels.

Figure 6.28. Graphiques Q-Q des résiduels.

Notez comment votre Q-Q plot et l’histogramme des résiduels sont encore mieux sans ces observations. Combien d’observations avec un résiduel large (>3 ou <-3) avez-vous? Ces observations ont-elles quelquechose en commun?

library(broom)
diag <- augment(model_final2) #Je viens de créer une nouvelle table dans laquelle les résiduels, distance de cook, etc se trouvent maintenant
diag_res <- subset(diag, (.std.resid < -3.0 | .std.resid > 3.0)) #Gardons seulement les résiduels standardisés <-3.0 ou >3.0
diag_res <- diag_res[order(diag_res$.std.resid),] #Plaçons les résiduels en ordre croissants
diag_res <- na.omit(diag_res) #Enlever les valeurs manquantes
Table 6.7. Observations avec les résiduels négatifs et positifs les plus larges.
.rownames log_cell kgmilk_ct kgmilk_ct_sq parity_ct parity_ct_sq breed .fitted .resid .hat .sigma .cooksd .std.resid
1078 8.214465 0.0 0.00 0 0 1 4.599325 3.615140 0.0083997 1.162928 0.0102372 3.109376
327 8.667852 -5.5 30.25 0 0 2 4.980429 3.687423 0.0038030 1.162744 0.0047777 3.164221
856 8.731498 -4.8 23.04 0 0 8 4.707686 4.023811 0.0053392 1.161708 0.0080121 3.455545
444 8.575462 -1.8 3.24 0 0 8 4.536343 4.039119 0.0050420 1.161661 0.0076191 3.468173

Réponse: Il y a seulement 4 observations extrêmes. Seulement des résiduels positifs (i.e. le modèle sous-estime la vraie valeur). Toutes des 1ère lactation. Un cellcount élevé (i.e. > 3,000,000 cell./ml), mais des production assez moyennes. Différentes races. Le modèle à donc de la difficulté (i.e. il sous estime) la valeur de cellcount pour les 1ère lactation avec un cellcount élevé.

10.3. Vérifiez maintenant les 10 observations avec les leviers les plus grands. Ont-elles quelquechose en commun?

diag_hat <- diag[order(-diag$.hat),]
levier <- head(diag_hat, 10)
Table 6.8. Observations avec les leviers les plus grands.
.rownames log_cell kgmilk_ct kgmilk_ct_sq parity_ct parity_ct_sq breed .fitted .resid .hat .sigma .cooksd .std.resid
445 6.975414 14.0 196.00 7 49 2 5.248804 1.7266102 0.0842281 1.166829 0.0274545 1.5453153
812 6.042633 -5.4 29.16 7 49 3 5.241207 0.8014259 0.0815466 1.167832 0.0056933 0.7162279
84 5.669881 -3.8 14.44 7 49 3 5.143628 0.5262528 0.0814274 1.167988 0.0024506 0.4702774
761 5.669881 -3.8 14.44 7 49 3 5.143628 0.5262528 0.0814274 1.167988 0.0024506 0.4702774
446 3.688880 10.8 116.64 7 49 2 5.281918 -1.5930382 0.0801917 1.167024 0.0220562 -1.4226366
500 3.912023 23.1 533.61 4 16 2 5.630969 -1.7189460 0.0571116 1.166877 0.0174049 -1.5161721
1116 4.499810 21.8 475.24 3 9 2 5.470710 -0.9709003 0.0447326 1.167719 0.0042371 -0.8508022
733 6.327937 -1.0 1.00 6 36 1 5.813870 0.5140673 0.0403140 1.167998 0.0010607 0.4494401
813 4.812184 0.4 0.16 6 36 8 5.593501 -0.7813167 0.0380738 1.167857 0.0023032 -0.6822957
210 4.663439 20.9 436.81 3 9 2 5.456029 -0.7925905 0.0377796 1.167850 0.0023504 -0.6920349

Réponse: Beaucoup de parité 8, production, race et cellcount assez variés. En fait être une 8ième lactation, peu importe le niveau des autres prédicteurs, semble être une combinaison de prédicteurs inusitée.

10.4. Vérifiez maintenant les 10 observations les plus influentes. Ont-elles quelquechose en commun?

diag_cook <- diag[order(-diag$.cooksd),]
influent <- head(diag_cook, 10)
Table 6.9. Observations les plus influentes.
.rownames log_cell kgmilk_ct kgmilk_ct_sq parity_ct parity_ct_sq breed .fitted .resid .hat .sigma .cooksd .std.resid
445 6.975414 14.0 196.00 7 49 2 5.248804 1.726610 0.0842281 1.166829 0.0274545 1.545315
446 3.688880 10.8 116.64 7 49 2 5.281918 -1.593038 0.0801917 1.167024 0.0220562 -1.422637
214 7.634821 20.2 408.04 2 4 2 5.192483 2.442337 0.0341968 1.165683 0.0200522 2.128520
874 7.903966 9.8 96.04 6 36 2 5.520732 2.383233 0.0344921 1.165798 0.0192701 2.077328
500 3.912023 23.1 533.61 4 16 2 5.630969 -1.718946 0.0571116 1.166877 0.0174049 -1.516172
916 8.984318 -14.0 196.00 0 0 2 5.629210 3.355108 0.0154246 1.163616 0.0164238 2.895999
488 8.999619 1.9 3.61 5 25 2 5.859827 3.139793 0.0143365 1.164179 0.0133392 2.708651
880 6.853299 18.8 353.44 2 4 8 4.948457 1.904842 0.0306928 1.166638 0.0108686 1.657084
1078 8.214465 0.0 0.00 0 0 1 4.599325 3.615140 0.0083997 1.162928 0.0102372 3.109376
1080 3.850148 11.4 129.96 6 36 2 5.495597 -1.645449 0.0354268 1.167005 0.0094531 -1.434938

Réponse: Il y a peu d’observations influentes et on voit difficilement un profil type en termes de parité, production, race (beaucoup de Holstein, mais c’est aussi la race la plus fréquente dans le jeu de données) ou de CCS.

  1. Présentation des résultats.
    11.1. Présentez les résultats de votre modèle dans une table que vous pourriez soumettre dans une publication scientifique.
#Le package jtools et la fonction summ permettent de générer des tables de résultats un peu plus attrayantes que la fonction summary
library(jtools)
j <- summ(model_final2, confint = TRUE) #Je créer un objet j qui contiendra différents éléments. Ici j'ai demandé d'utiliser les IC95 (plutôt que les erreur-types).
j$coeftable #L'élément de j qui se nomme coeftable contient les coefficients, les IC95 (ou les erreur-types), les valeurs de T, las valeurs de P.
##                     Est.          2.5%        97.5%     t val.             p
## (Intercept)   4.59932473  4.3893612016  4.809288257 42.9812943 4.033724e-237
## kgmilk_ct    -0.04728450 -0.0590979988 -0.035471011 -7.8536177  9.609453e-15
## kgmilk_ct_sq  0.00148937  0.0003835792  0.002595162  2.6427669  8.340726e-03
## parity_ct     0.55130050  0.4259755597  0.676625440  8.6313784  2.110234e-17
## parity_ct_sq -0.05950089 -0.0860565013 -0.032945281 -4.3963925  1.207990e-05
## breed2        0.07598558 -0.1379004787  0.289871635  0.6970725  4.859056e-01
## breed3       -0.60044404 -0.8556607831 -0.345227288 -4.6162853  4.369817e-06
## breed8       -0.15291913 -0.3897495271  0.083911261 -1.2669331  2.054491e-01
#Dans RMarkdown, pour une sortie plus 'propre', je peux créer une table avec la fonction kable du package knitr. 
library(knitr)
Pres_table <- kable(j$coeftable,  caption="**Table 6.10.** Modèle de régression linéaire multiple sur l’effet de la production laitière journalière (en kg) sur le log du comptage des cellules somatiques (CCS) du lait (x1000 cell./ml) basé sur l’étude de 1128 vaches.", #Je peux spécifier un titre de table. 
      digits=3, #J'ai aussi indiqué le nombre de décimales que je veux présenter.
      col.names = c('Estimés', 'IC 95 inférieure', 'IC95 supérieure', 'Statistique de T','Valeur de P')) #Je peux renommer les titre des colonnes
#Le package KableExtra permet d'ajouter des 'footnotes' à la table que je viens de créer
library(kableExtra)
add_footnote(
  Pres_table, "L'intercept représente le log du CCS (en 1000 cellules/ml) pour une vache Ayrshire de 1ère lactation et produisant 20kg de lait. Les variables Parity et Breed sont incluses dans le modèle comme facteurs confondants. La race Ayrshire est utilisée comme valeur de référence pour la variable Breed; breed2=Holstein, breed3=Jersey et breed8=autre race.",
  notation = "none")%>%
  kable_styling()
Table 6.10. Modèle de régression linéaire multiple sur l’effet de la production laitière journalière (en kg) sur le log du comptage des cellules somatiques (CCS) du lait (x1000 cell./ml) basé sur l’étude de 1128 vaches.
Estimés IC 95 inférieure IC95 supérieure Statistique de T Valeur de P
(Intercept) 4.599 4.389 4.809 42.981 0.000
kgmilk_ct -0.047 -0.059 -0.035 -7.854 0.000
kgmilk_ct_sq 0.001 0.000 0.003 2.643 0.008
parity_ct 0.551 0.426 0.677 8.631 0.000
parity_ct_sq -0.060 -0.086 -0.033 -4.396 0.000
breed2 0.076 -0.138 0.290 0.697 0.486
breed3 -0.600 -0.856 -0.345 -4.616 0.000
breed8 -0.153 -0.390 0.084 -1.267 0.205
L’intercept représente le log du CCS (en 1000 cellules/ml) pour une vache Ayrshire de 1ère lactation et produisant 20kg de lait. Les variables Parity et Breed sont incluses dans le modèle comme facteurs confondants. La race Ayrshire est utilisée comme valeur de référence pour la variable Breed; breed2=Holstein, breed3=Jersey et breed8=autre race.

L’effet de la production laitière n’est plus sur l’échelle originale. En plus, la relation entre production et CCS n’est pas linéaire. Tout ça rend votre modèle difficile à interpréter et il faudrait possiblement trouver une manière de rendre l’information plus digestible pour vos lecteurs.

11.2. Vous pourriez présenter comment le CCS varie en fonction de la production laitière pour différents scénarios. Vous pourriez, par exemple, compléter la table suivante, en calculant la valeur prédite pour chaque scénario à l’aide de votre modèle, puis en retransformant ces valeurs sur l’échelle originale:

Table 6.11. Valeurs prédites de comptage des cellules somatiques (CCS) du lait (x1000 cell./ml) d’une vache Ayrshire pour différentes combinaisons de production et parité.
Production 1ère lactation 2ième lactation 3ième et plus
10kg/jour 72 118 171
20kg/jour 70 115 166
30kg/jour 92 150 218

11.3. Encore mieux : à partir d’une table R contenant les valeurs prédites, retransformez la valeur prédite sur l’échelle originale en créant une nouvelle variable \(CCS=exp(valeur prédite)\). Ensuite, vous pourrez utiliser le package ggplot2 pour représenter dans un graphique nuage de points la relation entre la production laitière (en x) et la valeur prédite de CCS (en y).
C’est plus simple à comprendre ainsi n’est-ce pas?

diag$pred <- exp(diag$.fitted) #Je créer une variable de CCS sur l'échalle originale
diag$kgmilk <- diag$kgmilk_ct+20 #Je dois aussi recréer ma variable kgmilk
diag$parity <- factor(diag$parity_ct+1) #Je dois aussi recréer ma variable parité
library(ggplot2)
ggplot(diag, aes(x=kgmilk, y=pred)) +
  geom_point(aes(colour=parity)) +  
  geom_smooth(method="loess", span=2)+ 
  labs(x="Production (en kg/j)", y="CCS (en 1000 cellules/ml)")+ 
  theme_bw()
**Figure 6.29.** Valeurs de CCS (par 1000 cell./ml) prédites par le modèle en fonction de la production laitière (en kg/j) et du nombre de lactation.

Figure 6.29. Valeurs de CCS (par 1000 cell./ml) prédites par le modèle en fonction de la production laitière (en kg/j) et du nombre de lactation.

7 Régression logistique

7.1 Généralités

Il existe aussi plusieurs procédures dans R permettant d’effectuer une régression logistique. Nous travaillerons principalement avec la fonction glm qui comblera la plupart de vos besoins de ce côté. Notez que nous utiliserons cette même fonction pour d’autres types de modèle que nous verrons plus tard (e.g., Poisson, binomiale négative). Puisque la fonction glm peut être utilisée pour plusieurs type de régression, il faudra donc indiquer la famille de régression qui nous intéresse, dans ce cas-ci l’argument family=binomial indiquera que notre variable dépendante est binomiale (i.e., elle prend seulement 2 valeurs). Dans ce cas, la fonction de lien par défaut sera la fonction logit. On aura donc une régression logistique. Notez que, à part l’ajout de family-binomial la syntaxe est identique à celle de la fonction lm.

Le jeu de donnée Nocardia sera utilisé pour cette section.

#J'importe ce jeu de données
nocardia <-read.csv(file="nocardia.csv", header=TRUE, sep=";")
head(nocardia)
##   id casecont numcow prod        bscc dbarn dout dcprep dcpct dneo dclox doth
## 1  1        0     16 20,1 446,2000122     2    1      4     0    0     0    1
## 2  2        0     16 22,3         214     2    1      3   100    1     0    1
## 3  3        0     18 24,9         260     2    1      3    25    0     0    1
## 4  4        0     18      184,1999969     1    1      3     1    0     0    1
## 5  5        0     20 34,5 61,40000153     2    1      3   100    0     1    0
## 6  6        0     21 22,7 80,19999695     1    1      3     0    0     0    0
#J'indique les variables catégoriques dans mon jeu de données
nocardia$dbarn <- factor(nocardia$dbarn) 
nocardia$dneo <- factor(nocardia$dneo) 
nocardia$dclox <- factor(nocardia$dclox) 

#Je fais une régression logistique

modele_1 <- glm(data = nocardia, casecont ~ dcpct + dbarn, family = binomial)
summary(modele_1)
## 
## Call:
## glm(formula = casecont ~ dcpct + dbarn, family = binomial, data = nocardia)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5537  -1.2441   0.1261   1.1063   1.9280  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)   
## (Intercept) -1.025831   0.634461  -1.617  0.10591   
## dcpct        0.018774   0.006196   3.030  0.00244 **
## dbarn2      -0.681944   0.449586  -1.517  0.12931   
## dbarn3       0.038615   0.960075   0.040  0.96792   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 149.72  on 107  degrees of freedom
## Residual deviance: 135.49  on 104  degrees of freedom
## AIC: 143.49
## 
## Number of Fisher Scoring iterations: 4

Plusieurs éléments sont présentés. D’abord, des résultats sur les résiduels de déviance (on y reviendra). Puis les coefficients, erreur-types et les résultats des tests de Wald qui permettent de tester chacun des coefficients, un à la fois (l’hypothèse nulle est que β=0). Notez que le résultat Residual deviance (135.49 avec 104 degrés de liberté) correspond au -2 log likelihood.

7.2 Effectuer un test de rapport de vraisemblance

Pour comparer le modèle complet avec le modèle nul (i.e., avec juste l’intercept) il faudra faire un rapport de vraisemblance (likelihood ratio test). La fonction lrtest du package lmtest permet de réaliser ce genre de test.

library(lmtest)
lrtest(modele_1)#teste le rapport de vraisemblance du modèle
## Likelihood ratio test
## 
## Model 1: casecont ~ dcpct + dbarn
## Model 2: casecont ~ 1
##   #Df  LogLik Df  Chisq Pr(>Chisq)   
## 1   4 -67.747                        
## 2   1 -74.860 -3 14.225   0.002614 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Ici, la conclusion serait que au moins un des coefficients (dcpct ou dbarn) est différent de 0 (P=0.003).

Pour comparer un modèle complet vs. un modèle réduit ont utilisera la même fonction du même package, mais après avoir créé les deux modèles.

mod_red<-glm(data=nocardia, casecont~ dcpct + dbarn, family="binomial" )
mod_comp<-glm(data=nocardia, casecont~ dcpct + dneo + dclox + dbarn, family="binomial" )

lrtest(mod_comp, mod_red)#likelihood ratio test
## Likelihood ratio test
## 
## Model 1: casecont ~ dcpct + dneo + dclox + dbarn
## Model 2: casecont ~ dcpct + dbarn
##   #Df  LogLik Df  Chisq Pr(>Chisq)    
## 1   6 -51.158                         
## 2   4 -67.747 -2 33.178  6.244e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

La conclusion serait que au moins un des deux coefficients (dneo et/ou dclox) est différent de 0 (P<0.001). C’est aussi à l’aide de la fonction lrtest qu’on pourra réaliser un test sur l’ensemble des variables indicateurs d’une variables avec > 2 catégories, l’équivalent du test de F en régression linéaire.

7.3 Ajouter des IC95

Vous pouvez ajouter des IC95 avec la fonction confint:

confint(modele_1, level= 0.95)
##                    2.5 %     97.5 %
## (Intercept) -2.354149597 0.16936727
## dcpct        0.007243426 0.03183774
## dbarn2      -1.582513404 0.19021182
## dbarn3      -1.882433338 2.00161262

7.4 Choisir valeur de référence pour les variables catégoriques

Vous pouvez choisir les valeurs de référence pour les variables catégoriques avec la fonction relevel:

nocardia<-within(nocardia, dbarn<-relevel(dbarn, ref=1)) #Dans ce cas, ça ne changera rien puisque R avait déjà prit la valeur 1 comme catégorie de référence

7.5 Produire des tables de résultats

Le package jtools vous permet de présenter des tables de résultats plus jolies:

library(jtools)
j <- summ(modele_1, confint = TRUE)
j$coeftable
##                    Est.         2.5%      97.5%      z val.           p
## (Intercept) -1.02583119 -2.269351164 0.21768878 -1.61685557 0.105909460
## dcpct        0.01877361  0.006630146 0.03091708  3.03007440 0.002444935
## dbarn2      -0.68194417 -1.563115697 0.19922736 -1.51682840 0.129310014
## dbarn3       0.03861550 -1.843097887 1.92032888  0.04022131 0.967916686

Ou encore, si vous utilisez RMarkdown:

library(knitr)
library(kableExtra)
kable(round(j$coeftable, digits=3), caption="**Table 7.1.** Résultats du modèle.")%>%
  kable_styling()
Table 7.1. Résultats du modèle.
Est. 2.5% 97.5% z val. p
(Intercept) -1.026 -2.269 0.218 -1.617 0.106
dcpct 0.019 0.007 0.031 3.030 0.002
dbarn2 -0.682 -1.563 0.199 -1.517 0.129
dbarn3 0.039 -1.843 1.920 0.040 0.968

7.5.1 Présenter les rapport de cotes plutôt que les log odds

Si vous désirez obtenir les rapports de cotes, alors vous pouvez simplement demander l’exposant de vos résultats comme ceci:

#Je demande de présenter les coefficients du modèle mis à l'exposant
exp(coef(modele_1))
## (Intercept)       dcpct      dbarn2      dbarn3 
##   0.3584984   1.0189509   0.5056330   1.0393708

Pour obtenir rapports de cotes et IC95 des rapports de cotes:

#Ici j'ai demandé de créer une colonne représentant un vecteur de nombres (que j'ai nommé OR et qui seront les OR) et d'y juxtaposer (fonction cbind) les IC95 du modèle. Il ne reste plus qu'à exponentier les valeurs contenues dans ces 3 colonnes pour avoir des OR et leurs IC95
exp(cbind(OR = coef(modele_1), confint(modele_1)))
##                    OR      2.5 %   97.5 %
## (Intercept) 0.3584984 0.09497424 1.184555
## dcpct       1.0189509 1.00726972 1.032350
## dbarn2      0.5056330 0.20545805 1.209506
## dbarn3      1.0393708 0.15221925 7.400981

On pourrait même arrondir pour faire plus joli et sortir ça en utilisant RMarkdown.

kable(round(exp(cbind(OR = coef(modele_1), confint(modele_1))), digits=2), caption="**Table 7.2.** Résultats du modèle.")%>%
  kable_styling()
Table 7.2. Résultats du modèle.
OR 2.5 % 97.5 %
(Intercept) 0.36 0.09 1.18
dcpct 1.02 1.01 1.03
dbarn2 0.51 0.21 1.21
dbarn3 1.04 0.15 7.40

Dans ce cas, on voit qu’une augmentation de 1 unité de dcpct (le % de vaches traitées au tarissement) augmente les odds de mammite à nocardia par un facteur de 1.02 (IC95: 1.01, 1.03).

7.6 Spécifier pour quelle augmentation d’un prédicteur continu le rapport de cotes est calculé

Si vous voulez produire le rapport de cotes pour une augmentation de 10 ou 20 unités de dcpct vous pourriez mettre à l’échelle la variable dcpct afin que celle-ci représente une augmentation de 10 ou 20 unités et utiliser ces nouvelles variables dans le modèle. Par exemple, pour une augmentation de 10 points de pourcentage:

nocardia$dcpct10 <- nocardia$dcpct/10

modele_10 <- glm(data = nocardia, casecont ~ dcpct10 + dbarn, family = binomial)

round(exp(cbind(OR = coef(modele_10), confint(modele_10))), digits=2)
##               OR 2.5 % 97.5 %
## (Intercept) 0.36  0.09   1.18
## dcpct10     1.21  1.08   1.37
## dbarn2      0.51  0.21   1.21
## dbarn3      1.04  0.15   7.40

Donc une augmentation de 10 unités multiplie les odds de nocardia par 1.21 (IC95: 1.08, 1.37).

Vous auriez aussi pu simplement multiplier le coefficient et ses erreur-types par 10 et ensuite les mettre à l’exposant:

#Créons un objet avec les résultats du modèle
library(jtools)
res <- summ(modele_1)

#Dans l'objet res$coeftable la première colonne est pour les coefficents et la 2ième est pour les erreur-types. Et la 2ième rangée est pour dcpct. Le coefficient de dcpct est donc en rangée 2 et colone 1 ou res$coeftable[2,1]
OR <- exp(10*res$coeftable[2,1])

#Et les erreur-types sont en res$coeftable[2,2]
L95 <- exp(10*res$coeftable[2,1]-1.96*10*res$coeftable[2,2])
U95 <- exp(10*res$coeftable[2,1]+1.96*10*res$coeftable[2,2])

#De là:
round(cbind(OR10=OR, LowerCI=L95, UpperCI=U95), digits=2)
##      OR10 LowerCI UpperCI
## [1,] 1.21    1.07    1.36

Comme vous le voyez, il y a plusieurs manières d’arriver au même résultat!

7.7 Évaluer une interaction entre 2 variables

Comme pour la fonction lm vous n’avez qu’à indiquer dans votre modèle la multiplication des effets (dneo*dclox). La fonction glm se chargera alors de créer toutes les variables indicateurs nécessaires.

modele_inter <- glm(data = nocardia, casecont ~ dcpct + dneo*dclox, family = binomial)
library(jtools)
inter <- summ(modele_inter, confint = TRUE)
inter$coeftable
##                     Est.         2.5%       97.5%    z val.            p
## (Intercept)  -3.77689649 -5.723632083 -1.83016091 -3.802561 0.0001432079
## dcpct         0.02261751  0.007480181  0.03775484  2.928489 0.0034061354
## dneo1         3.18400225  1.543122188  4.82488232  3.803160 0.0001428619
## dclox1        0.44570471 -1.565269702  2.45667913  0.434399 0.6639987570
## dneo1:dclox1 -2.55199707 -4.913900617 -0.19009352 -2.117708 0.0341997943

7.8 Comparer rapports de cotes pour une combinaison spécifique de prédicteurs

La fonction pairs du package emmeans vous permet de comparer toutes les combinaisons possibles d’un ou plusieurs prédicteurs catégoriques et/ou quantitatifs.

library(emmeans)
contrast <- emmeans(modele_inter, c("dneo", "dclox")) 
pairs(contrast)  
##  contrast  estimate    SE  df z.ratio p.value
##  0 0 - 1 0   -3.184 0.837 Inf -3.803  0.0008 
##  0 0 - 0 1   -0.446 1.026 Inf -0.434  0.9726 
##  0 0 - 1 1   -1.078 0.953 Inf -1.131  0.6705 
##  1 0 - 0 1    2.738 0.773 Inf  3.541  0.0023 
##  1 0 - 1 1    2.106 0.666 Inf  3.164  0.0085 
##  0 1 - 1 1   -0.632 0.873 Inf -0.724  0.8875 
## 
## Results are given on the log odds ratio (not the response) scale. 
## P value adjustment: tukey method for comparing a family of 4 estimates

Rappellez-vous, si vous utilisez la fonction confintsur votre fonction pairs, vous aurez alors aussi les IC95.

library(emmeans)
contrast <- emmeans(modele_inter, c("dneo", "dclox")) 
confint(pairs(contrast))  
##  contrast  estimate    SE  df asymp.LCL asymp.UCL
##  0 0 - 1 0   -3.184 0.837 Inf    -5.335     -1.03
##  0 0 - 0 1   -0.446 1.026 Inf    -3.082      2.19
##  0 0 - 1 1   -1.078 0.953 Inf    -3.526      1.37
##  1 0 - 0 1    2.738 0.773 Inf     0.752      4.73
##  1 0 - 1 1    2.106 0.666 Inf     0.396      3.82
##  0 1 - 1 1   -0.632 0.873 Inf    -2.874      1.61
## 
## Results are given on the log odds ratio (not the response) scale. 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates

J’ai maintenant tous les contrastes pour les différentes combinaisons de dneo et dclox. Par exemple, la première ligne compare ceux qui n’utilisait aucun des deux produits (0 et 0) vs. ceux qui utilisait dneo mais pas dclox (1 et 0).

De là, si on voulait avoir les rapport de cote pour les différentes comparaisons plutôt que les log odds, j’utiliserai l’argument type="response".

confint(pairs(contrast, type="response"))
##  contrast  odds.ratio      SE  df asymp.LCL asymp.UCL
##  0 0 / 1 0     0.0414  0.0347 Inf   0.00482     0.356
##  0 0 / 0 1     0.6404  0.6570 Inf   0.04589     8.937
##  0 0 / 1 1     0.3404  0.3244 Inf   0.02942     3.939
##  1 0 / 0 1    15.4606 11.9565 Inf   2.12025   112.737
##  1 0 / 1 1     8.2177  5.4711 Inf   1.48575    45.452
##  0 1 / 1 1     0.5315  0.4639 Inf   0.05646     5.004
## 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates 
## Intervals are back-transformed from the log odds ratio scale

Dans ce cas, les odds de nocardia étaient 15.5 (95CI: 2.1, 112.7) fois plus grande pour les troupeaux utilisants seulement neomycine (1 et 0) vs. ceux utilisant seulement la cloxacilline (0 et 1).

7.9 Présenter l’effet des prédicteurs sur une échelle de probabilité

Présenter vos résultats sur une échelle de probabilité (plutôt que odds ou log odds) permettra de mieux illustrer l’effet de vos différents prédicteurs. La fonction plot_model() du package sjPlotvous permet d’obtenir une telle représentation graphique de vos résultats. L’option type="eff" permet de rapporter les résultats sur l’échelle d’une probabilité (plutôt que odds, log odds ou OR).

library(sjPlot)
plot_model(modele_inter, type="eff")
## $dcpct
**Figure 7.1.** Effet de différentes variables sur la probabilité de nocardia.

Figure 7.1. Effet de différentes variables sur la probabilité de nocardia. 

## 
## $dneo
**Figure 7.1.** Effet de différentes variables sur la probabilité de nocardia.

Figure 7.1. Effet de différentes variables sur la probabilité de nocardia. 

## 
## $dclox
**Figure 7.1.** Effet de différentes variables sur la probabilité de nocardia.

Figure 7.1. Effet de différentes variables sur la probabilité de nocardia.

Ont voit alors les graphiques pour chacune des variables du modèle. Par contre, souvent on voudra voir tout ensemble dans un seul graphique. On peut alors ajouter l’argument terms=c("var1", "var2", "var3"). La première variable apparaitra en x, la deuxième en y et la troisième séparera la figure en 2 figures.

library(sjPlot)
plot_model(modele_inter, type="eff", terms=c("dcpct", "dneo", "dclox"))
**Figure 7.2.** Effet de l'utilisation de la neomycine et du % de vache traitées au tarissement par niveau d'utilisation de la cloxacilline.

Figure 7.2. Effet de l’utilisation de la neomycine et du % de vache traitées au tarissement par niveau d’utilisation de la cloxacilline.

7.10 Linéarité de la relation (pour prédicteur quantitatif)

La linéarité de la relation est une supposition importante du modèle. Dans le modèle logistique, la relation entre le prédicteur et le log odds doit être une ligne droite, ce qui complique l’évaluation. Pour les prédicteurs quantitatifs, vous devrez toujours vérifier si cette supposition est bien respectée. Vous pouvez le faire simplement à l’aide du modèle polynomial (en ajoutant le \(prédicteur^2\) ou le \(prédicteur^2\) et le \(prédicteur^3\) dans votre modèle). Si les coefficients de ces termes sont significativement différents de zéro (i.e. P < 0.05), ont concluera que la relation est une courbe, ou une courbe avec un ou plusieurs points d’inflexion, respectivement.

7.11 Test de ‘fit’ de Hosmer-Lemeshow et de Pearson

La fonction hoslem.test du package ResourceSelection permet de réaliser le test de Hosmer-Lemeshow. Il faut simplement indiquer l’objet “modèle” avec lequel vous voulez travailler (par exemple, ici modele_inter). Dans cet objet, il y a toujours une variable nommée \(y\) et hoslem.test voudra l’utiliser, vous n’avez donc pas à modifier y dans le code. Il s’agit en fait de la variable réponse. Ont indique ensuite d’utiliser les valeurs prédites (fitted) et, encore une fois, l’objet “modèle” où elles se trouvent. Finalement on peut ou non indiquer le nombre de groupes utilisés pour le test, ici g=8.

library(ResourceSelection)
hoslem.test(modele_inter$y, fitted(modele_inter),g=8)
## 
##  Hosmer and Lemeshow goodness of fit (GOF) test
## 
## data:  modele_inter$y, fitted(modele_inter)
## X-squared = 1.4887, df = 6, p-value = 0.9602

Dans ce cas, le test ne rejette pas l’hypothèse nulle (i.e. le modèle « fit » bien les données).

C’est beaucoup plus demandant de réaliser les tests de fit de Déviance ou de Pearson dans R. Si vous trouvez une manière simple de le faire, indiquez-le moi! En théorie, ont peut générer les résiduels avec la fonction augment() du package broom. Puis, la fonction distinct() (du package dplyr) pourrait être utilisée pour ne conserver que les profils uniques de prédicteurs pour un jeu de données. La fonction dim() permettra de rapporter le nombre de lignes dans ce jeu de données réduit (i.e., le nombre de profils). Ensuite, ont pourrait faire la somme des résiduels de Pearson de chacun de ces profils après les avoir mis au carré avec la fonction sum et ^2. La fonction length() permettra de calculer le nombre de coefficients dans le modèle. Puis, finalement, on cherche la probabilité d’observer cette valeur dans une table de chi-carré avec le nombre de degrés de liberté approprié (i.e., le nombre de profils unique - le nombre de coefficients) en utilisant la fonction pchisqr(). Ouf!

library(broom)
diag <- augment(modele_inter, type.residuals = "pearson") #Je viens de créer une nouvelle table avec les résiduels, etc. 

library(dplyr)
#La fonction "distinct" me permet de ne conserver qu'une seule fois (i.e., une seule ligne) les valeurs prédites qui se répètent.   
profils <- distinct(diag, dcpct, dneo, dclox, .keep_all = TRUE)

#Dans ce cas, on voit avec la fonction "dim" qu'il y a 30 profils uniques.
n_prof <- dim(profils)
n_prof[1]
## [1] 30
#Je calcule la somme de ces résiduels au carré. Dans ce cas, j'obtiens 37.75
s <- sum(profils$.resid^2)
s
## [1] 60.54813
#Je calcule le nombre de coefficients avec la fonction length. Je dois enlever 1 pour l'intercept.
nb <- length(modele_inter$coefficients)-1
nb
## [1] 4
#Finalement, je vérifie à quelle probabilité la valeur 37.75 correspond dans une distribution de chi-carré avec 25 degrés de liberté (30 profils - 4 coefficients-1).
1-pchisq(s, (n_prof-nb-1))
## [1] 8.782706e-05 9.363621e-12

Dans ce cas, le test rejette l’hypothèse nulle (i.e. le modèle ne « fit » pas bien les données). Rappellez-vous, c’est normal de parfois obtenir des résultats différents avec les test de Homer-Lemeshow, de Pearson ou deviance.

7.12 Évaluation des profils extrêmes et/ou influents

Comme pour la fonction lm, vous pouvez demander de créer une nouvelle table contenant, en plus de vos variables originales, les différentes valeurs (e.g. résiduels de Pearson, de déviance, probabilité prédite, leviers, Delta-Beta) qui serviront à évaluer votre modèle. La fonction augment() du package broom vous permet de le faire. Vous pourrez ensuite trier cette table pour identifier, par exemple, les observations avec les résiduels, leviers ou distance de Cook les plus extrêmes et essayer de comprendre si ces observations ont quelque chose en commun.

library(broom)
diag <- augment(modele_inter) #Je viens de créer une nouvelle table dans laquelle les résiduels, distance de cook, etc se trouvent maintenant
head(diag)
## # A tibble: 6 x 10
##   casecont dcpct dneo  dclox .fitted .resid .std.resid   .hat .sigma  .cooksd
##      <int> <int> <fct> <fct>   <dbl>  <dbl>      <dbl>  <dbl>  <dbl>    <dbl>
## 1        0     0 0     0       -3.78 -0.213     -0.215 0.0216  1.01  0.000103
## 2        0   100 1     0        1.67 -1.92      -1.94  0.0209  0.988 0.0232  
## 3        0    25 0     0       -3.21 -0.281     -0.285 0.0291  1.01  0.000248
## 4        0     1 0     0       -3.75 -0.215     -0.218 0.0218  1.01  0.000107
## 5        0   100 0     1       -1.07 -0.768     -0.803 0.0847  1.00  0.00694 
## 6        0     0 0     0       -3.78 -0.213     -0.215 0.0216  1.01  0.000103

Notez que les valeurs prédites sont sur une échelle de log odds. Les valeurs prédites sur une échelle de probabilité ont cependant été conservées dans votre objet modèle. Vous pouvez donc simplement les ajouter à votre table de diagnostic, si vous le désirez.

diag$pred_prob <- modele_inter$fitted.values
head(diag)
## # A tibble: 6 x 11
##   casecont dcpct dneo  dclox .fitted .resid .std.resid   .hat .sigma  .cooksd
##      <int> <int> <fct> <fct>   <dbl>  <dbl>      <dbl>  <dbl>  <dbl>    <dbl>
## 1        0     0 0     0       -3.78 -0.213     -0.215 0.0216  1.01  0.000103
## 2        0   100 1     0        1.67 -1.92      -1.94  0.0209  0.988 0.0232  
## 3        0    25 0     0       -3.21 -0.281     -0.285 0.0291  1.01  0.000248
## 4        0     1 0     0       -3.75 -0.215     -0.218 0.0218  1.01  0.000107
## 5        0   100 0     1       -1.07 -0.768     -0.803 0.0847  1.00  0.00694 
## 6        0     0 0     0       -3.78 -0.213     -0.215 0.0216  1.01  0.000103
## # ... with 1 more variable: pred_prob <dbl>

La table suivante est un extrait des 10 premières observations de cette nouvelle table lorsque classée des résiduels de Pearson les plus grands aux plus petits. À partir de cette table, vous pourriez produire les graphiques qui vous intéresseront à l’aide de la fonction ggplot.

#Je pourrais maintenant ordonner cette table pour voir les 10 observations avec les résiduels les plus larges
diag_res <- diag[order(-diag$.resid),]
head(diag_res, 10)
## # A tibble: 10 x 11
##    casecont dcpct dneo  dclox .fitted .resid .std.resid   .hat .sigma .cooksd
##       <int> <int> <fct> <fct>   <dbl>  <dbl>      <dbl>  <dbl>  <dbl>   <dbl>
##  1        1    10 0     0      -3.55    2.68       2.71 0.0243  0.971  0.178 
##  2        1    50 1     1      -1.57    1.87       1.93 0.0592  0.989  0.0641
##  3        1   100 0     0      -1.52    1.85       1.94 0.0901  0.988  0.0990
##  4        1    83 0     1      -1.45    1.82       1.89 0.0707  0.989  0.0700
##  5        1   100 0     1      -1.07    1.65       1.73 0.0847  0.992  0.0589
##  6        1   100 0     1      -1.07    1.65       1.73 0.0847  0.992  0.0589
##  7        1     1 1     0      -0.570   1.43       1.50 0.0893  0.996  0.0381
##  8        1   100 1     1      -0.437   1.37       1.42 0.0757  0.997  0.0275
##  9        1   100 1     1      -0.437   1.37       1.42 0.0757  0.997  0.0275
## 10        1   100 1     1      -0.437   1.37       1.42 0.0757  0.997  0.0275
## # ... with 1 more variable: pred_prob <dbl>

Notez qu’une valeur prédite et un résiduel sont calculés pour chaque profil de prédicteur (et non pour chaque observation). Il est donc normal que les observations avec un profil de prédicteurs identique aient exactement les mêmes valeurs prédites et résiduels (e.g. les lignes 8, 9 et 10).

7.13 Sensibilité, spécificité et courbe ROC

La fonction roc() de la librairie pROC permet de créer un nouvel objet dans lequel la sensibilité (Se) et l’inverse de la spécificité (1-Sp) sont rapportés pour tous les seuils possibles de probabilité prédite par le modèle. Pour ce, vous devrez utiliser une table dans laquelle les valeurs prédites par le modèle sont rapportées (par exemple le jeu de données créé avec la fonction augment() de la librairie broom.

#Valeur prédictive du modèle
library(pROC)
roc_data <- roc(data=diag, response="casecont", predictor="pred_prob")

#Présenter les sensibilités et spécificités des différents seuils dans une même table.
accu <- round(cbind(Seuil=roc_data$thresholds, Se=roc_data$sensitivities, Sp=roc_data$specificities), digits=2)

#Voir la table
kable(accu,  caption="**Table x.** Sensibilité et spécificité du modèle pour différents seuil de probabilité prédite.")%>%
  kable_styling()
Table x. Sensibilité et spécificité du modèle pour différents seuil de probabilité prédite.
Seuil Se Sp
-Inf 1.00 0.00
0.02 1.00 0.13
0.02 1.00 0.15
0.03 1.00 0.17
0.03 0.98 0.17
0.04 0.98 0.19
0.05 0.98 0.20
0.09 0.98 0.22
0.14 0.98 0.24
0.17 0.96 0.26
0.18 0.96 0.28
0.18 0.94 0.41
0.22 0.93 0.41
0.27 0.89 0.57
0.32 0.89 0.59
0.35 0.89 0.61
0.37 0.87 0.61
0.38 0.87 0.63
0.38 0.87 0.69
0.39 0.87 0.70
0.41 0.80 0.80
0.45 0.80 0.81
0.48 0.78 0.83
0.51 0.76 0.83
0.55 0.76 0.85
0.60 0.74 0.85
0.69 0.69 0.87
0.79 0.65 0.91
0.83 0.63 0.91
0.84 0.61 0.91
Inf 0.00 1.00

La courbe ROC peut également être présentée de même que l’aire sous la courbe (l’AUC) à l’aide de la fonction plot.roc de la librairie pROC.

plot.roc(roc_data, print.auc = TRUE, grid = TRUE)
**Figure x.** Courbe ROC.

Figure x. Courbe ROC.

J’en profites pour vous émoustiller avec la même figure, mais interactive cette fois. Déplacer votre curseur sur la ligne pour voir les valeurs de Se et Sp apparaitrent. Avec le bouton de gauche de votre souris, vous pouvez aussi faire un zoom sur une section de la figure. Utilisez le double-clic pour sortir du zoom. J’ai utilisé pour ça la fonction plot_ly de la librairie plotly. Je vpous laisse découvrir…

library(plotly)
x_axis <- list(title = "(1-spécificité)")
y_axis <- list(title = "Sensibilité")
plot_ly(
  x=round((1-roc_data$specificities), digits=2),
  y=round(roc_data$sensitivities, digits=2),
  type="scatter",
  mode="line"
) %>%
  layout(
    title="ROC",
    xaxis=x_axis,
    yaxis=y_axis
  )

Figure x. Courbe ROC (interactive)

À l’aide de l’objet ROC créé, vous pourrez produire différents graphiques par exemple des graphiques illustrant comment la sensibilité (et/ou la spécificité) varie en fonction du seuil choisi.

library(plotly)
x_axis <- list(title = "Seuil de probabilité choisi")
y_axis <- list(title = "Précision")
plot_ly(
  x=round((1-roc_data$thresholds), digits=2),
  y=round(roc_data$sensitivities, digits=2),
  type="scatter",
  mode="line",
  name="Sensibilité"
) %>%
  add_trace(
    x=round((1-roc_data$thresholds), digits=2),
     y=round(roc_data$specificities, digits=2),
    name="Spécificité"
    )%>%
  
  layout(
    title="Précision du modèle",
    xaxis=x_axis,
    yaxis=y_axis
        )

Figure x. Sensibilité et spécificité en fonction du seuil choisi.

7.14 Travaux pratiques 4 - Régression logistique - Base

7.14.1 Exercices

Pour ce TP utilisez le fichier Nocardia (voir description VER p.823).

Dans cette étude nous sommes intéressés à décrire la probabilité d’être un cas par rapport à un contrôle selon la proportion de vaches taries ayant reçu un traitement antibiotique ou ayant reçu de la cloxacilline, néomycine etc.

  1. Avant de réaliser la régression logistique, on peut tout d’abord faire des tabulations croisées et calculer les rapports de cotes (RC) et tests de chi-carré pour comprendre les relations entre la variable dépendante et les prédicteurs catégoriques d’intérêt (dneo, dclox et dbarn). Après inspection de ces tables, quelles sont vos premières conclusions quant à la relation entre l’utilisation de cloxacilline et la probabilité de nocardiose, de même qu’entre l’utilisation de néomycine et Nocardia ?

  2. Vous pourriez aussi tenter de visualiser et/ou tester comment dcpct varie en fonction du statut nocardia. Que notez-vous?

  3. Vous êtes intéressé par le modèle de régression logistique suivant qui évalue l’effet d’utiliser neomycine et/ou cloxacilline sur la probabilité de Nocardia en gardant constant le type de stabulation et le % de vache traitée (facteurs confondants). \(logit(Pcasecont=1) = β_0 + β_1*dneo + β_2*dclox + β_3*dbarn + β_4*dcpct\) 3.1. Évaluer ce modèle à l’aide de la fonction glm. Assurez-vous d’indiquer le niveau de référence 0 pour la neomycine et la cloxacilline et le niveau de référence 1 (i.e. stabulation libre) pour le type de stabulation. Quelle est la valeur de chi-carré, le nombre de degré de liberté et la valeur de P du test de rapport de vraisemblance? Quelles sont vos conclusions? Quel était le test équivalent en régression linéaire?
    3.2. Comparez le modèle complet vs. un modèle sans la variable dbarn. vous obtiendrez une valeur de P de 0.06. Dans vos tables de résultats précédentes, des valeurs de P de 0.03 et 0.85 sont rapportées pour dbarn 2 et dbarn 3, respectivement. Qu’indiquent ces différentes valeurs de P et quels étaient les tests équivalents en régression linéaire?
    3.3. Quel est le coefficient et le rapport de cotes de dcpct? Comment les interprétez-vous?
    3.4. Quel serait le RC (et IC 95%) d’une augmentation de 15% de dcpct sur les odds de maladie?
    3.5. Quel est le RC de dneo ?
    3.6. Calculez l’IC 95% pour dneo? Comment interprétez-vous cet IC 95% et la valeur de P rapportée pour le test de Wald?

  4. La présence d’un biais de confusion peut être vérifiée en ajoutant la variable de confusion potentielle au modèle et ensuite en décidant si le coefficient de la variable d’intérêt a changé de manière substantielle. En assumant le diagramme causal suivant :

Figure 7.3. Diagramme causal de la relation entre utilisation de la néomycine et probabilité de mammite à Nocardia.

Évaluer le changement relatif de l’effet de dneo sur la probabilité de nocardiose lorsque le modèle est ajusté ou non pour dcpct. Jugez-vous que ce facteur confondant créé un biais important dans cette étude?

  1. Vous vous rappelez subitement que dans les modèles de régression, lorsque vous utilisez un prédicteur continu comme dcpct, celui-ci doit être linéairement associé avec votre variable dépendante (i.e. la relation est une droite).
    5.1. En régression logistique, c’est avec le RC ou le log odds que les variables sont linéairement associées?
    5.2. Vérifiez si la relation avec dcpct est linéaire. Quelles sont vos conclusions?

  2. Maintenant modélisez l’interaction entre neomycine et cloxacilline dans votre modèle avec dneo dclox dcpct et dbarn.
    6.1. Quel serait le odds de nocardiose (et IC 95%) dans les troupeaux où cloxacilline et néomycine sont utilisés vs. ceux où aucun de ces traitements n’est utilisé? Ces troupeaux sont-ils significativement différents?
    6.2. Quel serait le odds de nocardiose (et IC 95%) dans les troupeaux où cloxacilline et néomycine sont utilisés vs. ceux où seulement neomycine est utilisé? Ces troupeaux sont-ils significativement différents?

7.14.2 Code R et réponses

Pour ce TP utilisez le fichier Nocardia (voir description VER p.823).

#J'importe ce jeu de données
nocardia <-read.csv(file="nocardia.csv", header=TRUE, sep=";")
head(nocardia)
##   id casecont numcow prod        bscc dbarn dout dcprep dcpct dneo dclox doth
## 1  1        0     16 20,1 446,2000122     2    1      4     0    0     0    1
## 2  2        0     16 22,3         214     2    1      3   100    1     0    1
## 3  3        0     18 24,9         260     2    1      3    25    0     0    1
## 4  4        0     18      184,1999969     1    1      3     1    0     0    1
## 5  5        0     20 34,5 61,40000153     2    1      3   100    0     1    0
## 6  6        0     21 22,7 80,19999695     1    1      3     0    0     0    0
#J'indique les variables catégoriques dans mon jeu de données
nocardia$dbarn <- factor(nocardia$dbarn) 
nocardia$dneo <- factor(nocardia$dneo) 
nocardia$dclox <- factor(nocardia$dclox) 
nocardia$casecont <- factor(nocardia$casecont)

Dans cette étude nous sommes intéressés à décrire la probabilité d’être un cas par rapport à un contrôle selon la proportion de vaches taries ayant reçu un traitement antibiotique ou ayant reçu de la cloxacilline, néomycine etc.

  1. Avant de réaliser la régression logistique, on peut tout d’abord faire des tabulations croisées et calculer les rapports de cotes (RC) et tests de chi-carré pour comprendre les relations entre la variable dépendante et les prédicteurs catégoriques d’intérêt (dneo, dclox et dbarn). Après inspection de ces tables, quelles sont vos premières conclusions quant à la relation entre l’utilisation de cloxacilline et la probabilité de nocardiose, de même qu’entre l’utilisation de néomycine et Nocardia ?
#Dans sjPlot la fonction tab_xtab est intéressante pour générer les table 2x2 et le test de chi-carré
library(sjPlot)
#Pour dneo
tab_xtab(var.row = nocardia$dneo, var.col = nocardia$casecont, title = "dneo*casecont")
dneo*casecont
dneo casecont Total
0 1
0 29 5 34
1 25 49 74
Total 54 54 108
χ2=22.707 · df=1 · φ=0.478 · p=0.000 
#Les valeurs dans cette table peuvent ensuite être utilisées dans epiR pour calculer les mesures d'association et les chi-carré
library(epiR)
dat <- matrix(c(49, 25, 5, 29), nrow = 2, byrow = TRUE)
rownames(dat) <- c("D+", "D-"); colnames(dat) <- c("E+", "E-") 
epi.2by2(dat = as.table(dat), method = "cross.sectional", 
   conf.level = 0.95, units = 100, outcome = "as.columns")
##              Outcome +    Outcome -      Total        Prevalence *        Odds
## Exposed +           49           25         74                66.2       1.960
## Exposed -            5           29         34                14.7       0.172
## Total               54           54        108                50.0       1.000
## 
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Prevalence ratio                             4.50 (1.97, 10.28)
## Odds ratio                                   11.37 (3.92, 32.95)
## Attrib prevalence *                          51.51 (35.45, 67.57)
## Attrib prevalence in population *            35.29 (20.11, 50.48)
## Attrib fraction in exposed (%)              77.79 (49.29, 90.27)
## Attrib fraction in population (%)           70.59 (37.44, 86.17)
## -------------------------------------------------------------------
##  Test that OR = 1: chi2(1) = 24.725 Pr>chi2 = <0.001
##  Wald confidence limits
##  CI: confidence interval
##  * Outcomes per 100 population units

Réponse: RC (IC 95%) neomycine: 11.4 (3.9, 33.0) \(X^2\) : P < 0.001
Odds 11.4 fois plus élevé de Nocardia dans les troupeaux utilisant la néomycine.

#Pour dclox
tab_xtab(var.row = nocardia$dclox, var.col = nocardia$casecont, title = "dclox*casecont")
dclox*casecont
dclox casecont Total
0 1
0 35 46 81
1 19 8 27
Total 54 54 108
χ2=4.938 · df=1 · φ=0.235 · p=0.026 
library(epiR)
dat <- matrix(c(8, 19, 46, 35), nrow = 2, byrow = TRUE)
rownames(dat) <- c("D+", "D-"); colnames(dat) <- c("E+", "E-") 
epi.2by2(dat = as.table(dat), method = "cross.sectional", 
   conf.level = 0.95, units = 100, outcome = "as.columns")
##              Outcome +    Outcome -      Total        Prevalence *        Odds
## Exposed +            8           19         27                29.6       0.421
## Exposed -           46           35         81                56.8       1.314
## Total               54           54        108                50.0       1.000
## 
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Prevalence ratio                             0.52 (0.28, 0.96)
## Odds ratio                                   0.32 (0.13, 0.82)
## Attrib prevalence *                          -27.16 (-47.48, -6.84)
## Attrib prevalence in population *            -6.79 (-21.12, 7.54)
## Attrib fraction in exposed (%)              -91.67 (-253.30, -3.98)
## Attrib fraction in population (%)           -13.58 (-25.64, -2.68)
## -------------------------------------------------------------------
##  Test that OR = 1: chi2(1) = 5.975 Pr>chi2 = 0.01
##  Wald confidence limits
##  CI: confidence interval
##  * Outcomes per 100 population units

Réponse: RC (IC 95%) cloxacilline: 0.32 (0.13, 0.82) \(X^2\) : P = 0.01
Odds de Nocardia dans les troupeaux utilisant la cloxacilline sont multipliés par un facteur de 0.32 (i.e. odds sont plus faibles).

#Pour dbarn
tab_xtab(var.row = nocardia$dbarn, var.col = nocardia$casecont, title = "dbarn*casecont")
dbarn*casecont
dbarn casecont Total
0 1
1 13 22 35
2 38 29 67
3 3 3 6
Total 54 54 108
χ2=3.523 · df=2 · Cramer’s V=0.181 · Fisher’s p=0.165

Réponse: Pour dbarn on remarque 22 cas/35, 29 cas/67 et 3 cas/6 dans les troupeaux en stabulation entravée, libre, et autre, respectivement. Pas d’association significative (\(X^2\) : P = 0.158).

  1. Vous pourriez aussi tenter de visualiser et/ou tester comment dcpct varie en fonction du statut nocardia. Que notez-vous?

Réponse: Ici je pourrais simplement faire un box-plot de dcpct par casecont.

library(ggplot2)
ggplot(data=nocardia, aes(x=dcpct, y=casecont, fill=casecont)) + 
  #fill permettra d'attribuer les couleurs par valeur de casecont
  geom_boxplot(width=0.3) + 
  #width permet d'ajuster la largeur des boites
  geom_jitter(color="grey", alpha=0.8) + 
  #geom_jitter permet d'ajouter les points, mais en espacant ceux qui ont la même valeur, pour mieux les voir. color me permet d'indiquer une couleur pour les points. alpha ajoute de la transparence. 
  theme_classic() +
  #theme_classic est une thème avec fond blanc, sans gridlines
  theme(legend.position="none") + #J'enlève la légende, elle est inutile dans ce cas.
  coord_flip() #Par défaut R produit des box-plot horizontaux, coord_flip() permet de les mettre verticaux.
**Figure 7.4.** % des vaches traitées en fonction du statut (cas vs témoin).

Figure 7.4. % des vaches traitées en fonction du statut (cas vs témoin).

Dans le code si dessus, j’en ai mis un peu plus que nécessaire. Vous pourriez aussi vous contenter de beaucoup moins comme plus bas:

ggplot(data=nocardia, aes(x=dcpct, y=casecont)) +
  geom_boxplot()
**Figure 7.5.** % des vaches traitées en fonction du statut (cas vs témoin).

Figure 7.5. % des vaches traitées en fonction du statut (cas vs témoin).

Je pourrais aussi calculer la moyenne dans chacun des groupes (cas vs. témoin) et vérifier si cette moyenne varie en fonction du groupe. Dans le code plus bas le signe %>% indique à R une séquence d’actions à faire (aussi appellé un “pipeline”). Dans ce cas je demande: 1) prends l’objet nocardia (un jeu de données); 2) groupe les observation par niveau de la variable casecont (group_by); 3) dans ces groupes, calcule la moyenne et la médiane de la variable dcpct et appelle ces valeurs “Moyenne” et “Médiane.”

#Calculer la moyenne par groupe:
library(dplyr)
nocardia %>%
  group_by(casecont) %>%
  summarize(Moyenne=mean(dcpct), Médiane=median(dcpct))
## # A tibble: 2 x 3
##   casecont Moyenne Médiane
##   <fct>      <dbl>   <dbl>
## 1 0           63.7      99
## 2 1           87.5     100

Réponse: On voit dans les figures que la plupart des troupeaux “cas” traitaient 100% des vaches alors que, pour les troupeaux “témoins,” il y avait un peu plus de troupeaux avec moins de 100% de vaches traitées. Les moyennes et médianes sont respectivement 88% et 100% pour les troupeaux cas et 64% et 99% pour les troupeaux témoins.

  1. Vous êtes intéressé par le modèle de régression logistique suivant qui évalue l’effet d’utiliser neomycine et/ou cloxacilline sur la probabilité de Nocardia en gardant constant le type de stabulation et le % de vache traitée (facteurs confondants).

\(logit(P de casecont=1) = β_0 + β_1*dneo + β_2*dclox + β_3*dbarn + β_4*dcpct\)

3.1. Évaluer ce modèle à l’aide de la fonction glm. Assurez-vous d’indiquer le niveau de référence 0 pour la neomycine et la cloxacilline et le niveau de référence 1 (i.e. stabulation libre) pour le type de stabulation. Quelle est la valeur de chi-carré, le nombre de degré de liberté et la valeur de P du test de rapport de vraisemblance? Quelles sont vos conclusions? Quel était le test équivalent en régression linéaire?

#Placons d'abord les niveaux de référence
nocardia$dneo <- nocardia$dneo<-relevel(nocardia$dneo, ref="0")
nocardia$dclox <- nocardia$dclox<-relevel(nocardia$dclox, ref="0")
nocardia$dbarn <- nocardia$dbarn<-relevel(nocardia$dbarn, ref="1")

#Le modèle:
modele_1 <- glm(data=nocardia, casecont ~ dneo + dclox + dbarn + dcpct, family="binomial")
library(lmtest)
lrtest(modele_1)
## Likelihood ratio test
## 
## Model 1: casecont ~ dneo + dclox + dbarn + dcpct
## Model 2: casecont ~ 1
##   #Df  LogLik Df  Chisq Pr(>Chisq)    
## 1   6 -51.158                         
## 2   1 -74.860 -5 47.403  4.702e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Réponse: La valeur de chi-carré est 47.4 avec 5 degrés de liberté. La valeur de P est < 0.001. Au moins un des coefficients est différent de zéro. Le test équivalent en régression linéaire est le test de F.

3.2. Comparez le modèle complet vs. un modèle sans la variable dbarn. vous obtiendrez une valeur de P de 0.06. Dans vos tables de résultats précédentes, des valeurs de P de 0.03 et 0.85 sont rapportées pour dbarn 2 et dbarn 3, respectivement. Qu’indiquent ces différentes valeurs de P et quels étaient les tests équivalents en régression linéaire?

modele_red <- glm(data=nocardia, casecont ~ dneo + dclox + dcpct, family="binomial")
lrtest(modele_1, modele_red)
## Likelihood ratio test
## 
## Model 1: casecont ~ dneo + dclox + dbarn + dcpct
## Model 2: casecont ~ dneo + dclox + dcpct
##   #Df  LogLik Df  Chisq Pr(>Chisq)  
## 1   6 -51.158                       
## 2   4 -53.994 -2 5.6707     0.0587 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(modele_1)
## 
## Call:
## glm(formula = casecont ~ dneo + dclox + dbarn + dcpct, family = "binomial", 
##     data = nocardia)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.6949  -0.7853   0.1021   0.7692   2.6801  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -2.445696   0.854328  -2.863  0.00420 ** 
## dneo1        2.685280   0.677273   3.965 7.34e-05 ***
## dclox1      -1.235266   0.580976  -2.126  0.03349 *  
## dbarn2      -1.333732   0.631925  -2.111  0.03481 *  
## dbarn3      -0.218350   1.154293  -0.189  0.84996    
## dcpct        0.021604   0.007657   2.821  0.00478 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 149.72  on 107  degrees of freedom
## Residual deviance: 102.32  on 102  degrees of freedom
## AIC: 114.32
## 
## Number of Fisher Scoring iterations: 5

Réponse: Le P de 0.06 indique que les coefficients des variables indicateurs utilisées pour modéliser la variable catégorique dbarn sont tous égal à zéro (i.e. globalement, dbarn n’est pas associé à la probabilité de nocardiose). Il s’agit d’un test de rapport de vraisemblance comparant modèles complet et réduit et ce test est équivalent au test de F comparant modèles complet et réduit en régression linéaire.
La valeur de P de 0.03 indique si le coefficient de dbarn2 est différent de zéro. La valeur de P de 0.85 indique si le coefficient de dbarn3 est différent de zéro. Il s’agit de tests de \(X^2\) de Wald et c’est équivalent au test de T en régression linéaire. Normalement, on évaluerait d’abort le test global (rapport de vraissemblance) et, dans ce cas, on ne regarderait pas alors les valeurs individuelles puisque ce premier test n’est pas significatif.

3.3. Quel est le coefficient et le rapport de cotes de dcpct? Comment les interprétez-vous?

library(jtools)
j <- summ(modele_1, confint = TRUE)
#Les coefficients:
round(j$coeftable, digits=3)
##               Est.   2.5%  97.5% z val.     p
## (Intercept) -2.446 -4.120 -0.771 -2.863 0.004
## dneo1        2.685  1.358  4.013  3.965 0.000
## dclox1      -1.235 -2.374 -0.097 -2.126 0.033
## dbarn2      -1.334 -2.572 -0.095 -2.111 0.035
## dbarn3      -0.218 -2.481  2.044 -0.189 0.850
## dcpct        0.022  0.007  0.037  2.821 0.005
#Les rapports de cotes:
round(exp(j$coeftable), digits=2)
##              Est. 2.5% 97.5% z val.    p
## (Intercept)  0.09 0.02  0.46   0.06 1.00
## dneo1       14.66 3.89 55.30  52.71 1.00
## dclox1       0.29 0.09  0.91   0.12 1.03
## dbarn2       0.26 0.08  0.91   0.12 1.04
## dbarn3       0.80 0.08  7.72   0.83 2.34
## dcpct        1.02 1.01  1.04  16.80 1.00

Réponse: Coefficient=0.022; log odds d’être malade augmente de 0.022 unité par augmentation d’une unité (i.e. de 1%) du nombre de vache traitée.
RC=1.02; les odds de nocardia sont multipliées par 1.02 (l’exposant de 0.022) par augmentation d’une unité (i.e. de 1%) du nombre de vache traitée.

3.4. Quel serait le RC (et IC 95%) d’une augmentation de 15% de dcpct sur les odds de maladie?

nocardia$dcpct15 <- nocardia$dcpct/15
modele15 <- glm(data=nocardia, casecont ~ dneo + dclox + dbarn + dcpct15, family="binomial")

library(jtools)
j <- summ(modele15, confint = TRUE)
#Les rapports de cotes:
round(exp(j$coeftable), digits=2)
##              Est. 2.5% 97.5% z val.    p
## (Intercept)  0.09 0.02  0.46   0.06 1.00
## dneo1       14.66 3.89 55.30  52.71 1.00
## dclox1       0.29 0.09  0.91   0.12 1.03
## dbarn2       0.26 0.08  0.91   0.12 1.04
## dbarn3       0.80 0.08  7.72   0.83 2.34
## dcpct15      1.38 1.10  1.73  16.80 1.00

Réponse: RC (IC95): 1.38 (1.10, 1.73)

3.5. Quel est le RC de dneo ?
Réponse: RC: 14.66

3.6. Calculez l’IC 95% pour dneo? Comment interprétez-vous cet IC 95% et la valeur de P rapportée pour le test de Wald?
Réponse: IC95: (3.89, 55.30). L’IC 95% indique que le RC de dneo est différent de 1 (i.e. l’utilisation de néomycine est associée statistiquement à la probabilité de nocardiose). Le test de \(X^2\) de Wald indique que le coefficient de régression de dneo est différent de zéro (i.e. l’utilisation de néomycine est associée statistiquement à la probabilité de nocardiose).

  1. La présence d’un biais de confusion peut être vérifiée en ajoutant la variable de confusion potentielle au modèle et ensuite en décidant si le coefficient de la variable d’intérêt a changé de manière substantielle. En assumant le diagramme causal suivant :

Figure 7.6. Diagramme causal de la relation entre utilisation de la néomycine et probabilité de mammite à Nocardia.

Évaluer le changement relatif de l’effet de dneo sur la probabilité de nocardiose lorsque le modèle est ajusté ou non pour dcpct. Jugez-vous que ce facteur confondant créé un biais important dans cette étude?

Sur l’échelle log odds:

modele_incond <- glm(data=nocardia, casecont ~ dneo, family="binomial")
modele_cond_dcpct <- glm(data=nocardia, casecont ~ dneo + dcpct, family="binomial")

#Calculer différence relative sur l'échelle log odd
diff <- round(100*(modele_incond$coefficients[2]-modele_cond_dcpct$coefficients[2])/modele_incond$coefficients[2], digits=1)
#Créer une table avec log odds inconditionnelle, conditionnelle et diff relative 
cbind(inconditionnelle=modele_incond$coefficients[2], conditionnelle=modele_cond_dcpct$coefficients[2], Difference_relative=diff)
##       inconditionnelle conditionnelle Difference_relative
## dneo1         2.430802       2.400661                 1.2

Sur l’échelle RC:

#Calculer différence relative sur l'échelle RC
diff <- round(100*((exp(modele_incond$coefficients[2])-exp(modele_cond_dcpct$coefficients[2]))/exp(modele_incond$coefficients[2])), digits=2)
#Créer une table avec log odds inconditionnelle, conditionnelle et diff relative 
cbind(inconditionnelle=exp(modele_incond$coefficients[2]), conditionnelle=exp(modele_cond_dcpct$coefficients[2]), Difference_relative=diff)
##       inconditionnelle conditionnelle Difference_relative
## dneo1           11.368       11.03047                2.97

Réponse: D’une manière ou d’une autre, le biais semble minime (i.e. < 3% de différence dans nos estimés).

  1. Vous vous rappelez subitement que dans les modèles de régression, lorsque vous utilisez un prédicteur continu comme dcpct, celui-ci doit être linéairement associé avec votre variable dépendante (i.e. la relation est une droite).
    5.1. En régression logistique, c’est avec le RC ou le log odds que les variables sont linéairement associées?
    Réponse:: Avec le log odds (i.e. \(log(P/(1-P))\)
    5.2. Vérifiez si la relation avec dcpct est linéaire. Quelles sont vos conclusions?
#Je pourrais créer des variables au carré et au cube de dcpct après l'avoir centré sur valeur moyenne (75%)
nocardia$dcpct_ct <- nocardia$dcpct-75
nocardia$dcpct_ct_sq <- nocardia$dcpct_ct*nocardia$dcpct_ct
nocardia$dcpct_ct_cu <- nocardia$dcpct_ct*nocardia$dcpct_ct*nocardia$dcpct_ct

#Vérifions le modèle avec terme au carré (pour voir s'il il y a une courbe)
modele_carre <- glm(data=nocardia, casecont ~ dcpct_ct + dcpct_ct_sq, family="binomial")
summary(modele_carre)
## 
## Call:
## glm(formula = casecont ~ dcpct_ct + dcpct_ct_sq, family = "binomial", 
##     data = nocardia)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.3821  -1.3332   0.2478   1.0292   2.0633  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)
## (Intercept)  0.4503912  0.4348605   1.036    0.300
## dcpct_ct     0.0056391  0.0119672   0.471    0.637
## dcpct_ct_sq -0.0003716  0.0002956  -1.257    0.209
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 149.72  on 107  degrees of freedom
## Residual deviance: 136.50  on 105  degrees of freedom
## AIC: 142.5
## 
## Number of Fisher Scoring iterations: 4

Réponse: On peut vérifier si la relation est linéaire en ajoutant \(dcpct^2\), puis, si nécessaire, \(dcpct^2\) et \(dcpct^3\) au modèle. Bien sûr, vous aurez pris le soin de centrer dcpct (sur sa moyenne par exemple) avant de faire ses transformations afin d’éviter toute colinéarité. Dans ce cas, le coefficient pour \(dcpct^2\) n’est pas significatif (P = 0.21). Une courbe ne semble donc pas être nécessaire. C’est donc probablement inutile d’aller vérifier si de multiples points d’inflexions (i.e. \(dcpct^3\)) sont nécessaires. Si vous l’avez tout de même fait, vous aurez noté des valeurs de P de 0.68 et de 0.40 pour les termes au carré et au cube, respectivement. Donc la relation entre dcpct et le log odds de nocardiose semble être linéaire et pourra être modélisée sans l’ajout de termes polynomiaux.

  1. Maintenant modélisez l’interaction entre neomycine et cloxacilline dans votre modèle avec dneo dclox dcpct et dbarn.
modele_inter <- glm(data=nocardia, casecont ~ dneo*dclox + dbarn + dcpct, family="binomial")

6.1. Quel serait le odds de nocardiose (et IC 95%) dans les troupeaux où cloxacilline et néomycine sont utilisés vs. ceux où aucun de ces traitements n’est utilisé? Ces troupeaux sont-ils significativement différents?

library(emmeans)
contrast <- emmeans(modele_inter, c("dneo", "dclox")) 
confint(pairs(contrast, type="response")) 
##  contrast  odds.ratio      SE  df asymp.LCL asymp.UCL
##  0 0 / 1 0     0.0215  0.0206 Inf   0.00182     0.254
##  0 0 / 0 1     0.4266  0.4635 Inf   0.02617     6.954
##  0 0 / 1 1     0.1573  0.1695 Inf   0.00988     2.504
##  1 0 / 0 1    19.8672 16.5247 Inf   2.34494   168.323
##  1 0 / 1 1     7.3257  5.0901 Inf   1.22922    43.659
##  0 1 / 1 1     0.3687  0.3452 Inf   0.03329     4.084
## 
## Results are averaged over the levels of: dbarn 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates 
## Intervals are back-transformed from the log odds ratio scale

Réponse: Ce serait la 3ième ligne de la table précédente. Donc RC (IC95): 0.34 (0.03, 3.9). Comme la valeur nulle (1.0) est incluse dans l’IC95, il n’y a pas de différence signitificative dans les odds de nocardia entre ces deux types de troupeaux.

6.2. Quel serait le odds de nocardiose (et IC 95%) dans les troupeaux où cloxacilline et néomycine sont utilisés vs. ceux où seulement neomycine est utilisé? Ces troupeaux sont-ils significativement différents?
Réponse: Ce serait la 5ième ligne de la table précédente. Donc RC (IC95): 8.2 (1.5, 45.5). Comme la valeur nulle (1.0) n’est pas incluse dans l’IC95, il y a une différence signitificative dans les odds de nocardia entre ces deux types de troupeaux.

7.15 Travaux pratiques 5 - Régression logistique - Évaluation du modèle

7.15.1 Exercices

Pour ce TP utilisez le fichier Nocardia (voir description VER p.823).

Utilisez le modèle suivant: \(logit(Pcasecont=1) = β_0 + β_1*dneo + β_2*dclox + β_3*dneo*dclox + β_4*dcpct\)

  1. Lorsqu’une interaction est présente, il devient difficile de présenter clairement vos résultats. À l’aide de la fonction pairs du package emmeans vous seriez cependant capable de créer une table comme proposée dans Knol et VanderWeele (2012).5 Une autre manière consisterait à Présenter l’effet de vos prédicteurs graphiquement sur une échelle de probabilité. Présentez ce graphique. Quel groupe de troupeaux se démarque particulièrement des autres en terme de probabilité de nocardiose?

  1. Évaluez l’adéquation du modèle. Quels sont les résultats et votre interprétation du test de Hosmer-Lemeshow et du test de Pearson?

  2. Dans ce cas, notez-vous un problème de sur-dispersion ou de sous-dispersion des données ? Cela-signifie que la variance observée est plus grande ou plus petite que la variance attendue?

  3. La valeur prédictive d’un modèle peut également être évaluée à l’aide d’une courbe ROC. Représenter graphiquement la courbe ROC. Quel est l’aire sous la courbe pour votre modèle ? Quelle serait la sensibilité et la spécificité de votre modèle si on fixe un seuil de 50% (i.e. si modèle prédit probabilité de nocardiose > 50% alors on diagnostique le troupeau comme nocardia positif)?

  4. Quel est le profil d’observation avec le résiduel de Pearson le plus élevé? Combien y-a-t’il d’observations dans ce profil?

  5. Quel profil d’observation avait le plus d’influence sur le coefficient de régression de dcpct? Pourquoi à votre opinion?

7.15.2 Code R et réponses

Pour ce TP utilisez le fichier Nocardia (voir description VER p.823).

#J'importe ce jeu de données
nocardia <-read.csv(file="nocardia.csv", header=TRUE, sep=";")
head(nocardia)
##   id casecont numcow prod        bscc dbarn dout dcprep dcpct dneo dclox doth
## 1  1        0     16 20,1 446,2000122     2    1      4     0    0     0    1
## 2  2        0     16 22,3         214     2    1      3   100    1     0    1
## 3  3        0     18 24,9         260     2    1      3    25    0     0    1
## 4  4        0     18      184,1999969     1    1      3     1    0     0    1
## 5  5        0     20 34,5 61,40000153     2    1      3   100    0     1    0
## 6  6        0     21 22,7 80,19999695     1    1      3     0    0     0    0
#J'indique les variables catégoriques dans mon jeu de données
nocardia$dbarn <- factor(nocardia$dbarn) 
nocardia$dneo <- factor(nocardia$dneo) 
nocardia$dclox <- factor(nocardia$dclox) 
nocardia$casecont <- factor(nocardia$casecont)

Utilisez le modèle suivant: \(logit(Pcasecont=1) = β_0 + β_1*dneo + β_2*dclox + β_3*dneo*dclox + β_4*dcpct\)

modele <- glm(data = nocardia, casecont ~ dneo*dclox + dcpct, family = binomial)
summary(modele)
## 
## Call:
## glm(formula = casecont ~ dneo * dclox + dcpct, family = binomial, 
##     data = nocardia)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9191  -0.7682   0.1874   0.5876   2.6755  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -3.776896   0.993251  -3.803 0.000143 ***
## dneo1         3.184002   0.837199   3.803 0.000143 ***
## dclox1        0.445705   1.026026   0.434 0.663999    
## dcpct         0.022618   0.007723   2.928 0.003406 ** 
## dneo1:dclox1 -2.551997   1.205075  -2.118 0.034200 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 149.72  on 107  degrees of freedom
## Residual deviance: 103.42  on 103  degrees of freedom
## AIC: 113.42
## 
## Number of Fisher Scoring iterations: 5
  1. Lorsqu’une interaction est présente, il devient difficile de présenter clairement vos résultats. À l’aide de la fonction pairs du package emmeans vous seriez cependant capable de créer une table comme proposée dans Knol et VanderWeele (2012).6 Une autre manière consisterait à Présenter l’effet de vos prédicteurs graphiquement sur une échelle de probabilité. Présentez ce graphique. Quel groupe de troupeaux se démarque particulièrement des autres en terme de probabilité de nocardiose?
library(sjPlot)
plot_model(modele, type="eff", terms=c("dcpct", "dneo", "dclox"))
**Figure x.** Effet sur la probabilité de nocardia de l'utilisation de la neomycine et du % de vache traitées au tarissement par niveau d'utilisation de la cloxacilline.

Figure x. Effet sur la probabilité de nocardia de l’utilisation de la neomycine et du % de vache traitées au tarissement par niveau d’utilisation de la cloxacilline.

Réponse: Les troupeaux utilisant seulement la néomycine (sans cloxacilline) semblent avoir une probabilité beaucoup plus élevée de nocardiose.

  1. Évaluez l’adéquation du modèle. Quels sont les résultats et votre interprétation du test de Hosmer-Lemeshow et du test de Pearson?

Réponse:
Test de Homer-Lemeshow

library(ResourceSelection)
hoslem.test(modele$y, fitted(modele), g=8)
## 
##  Hosmer and Lemeshow goodness of fit (GOF) test
## 
## data:  modele$y, fitted(modele)
## X-squared = 1.4887, df = 6, p-value = 0.9602

Interprétation: Le modèle est adéquat.

Test de Pearson

library(broom)
diag <- augment(modele, type.residuals = "pearson") #Je viens de créer une nouvelle table avec les résiduels, etc. 

library(dplyr)
#La fonction "distinct" me permet de ne conserver qu'une seule fois (i.e., une seule ligne) les valeurs prédites qui se répètent.   
profils <- distinct(diag, dcpct, dneo, dclox, .keep_all = TRUE)

#Dans ce cas, on voit avec la fonction "dim" qu'il y a 30 profils uniques.
n_prof <- dim(profils)
n_prof[1]
## [1] 30
#Je calcule la somme de ces résiduels au carré. Dans ce cas, j'obtiens 37.75
s <- sum(profils$.std.resid^2)
s
## [1] 37.74577
#Je calcule le nombre de coefficients avec la fonction length
nb <- length(modele$coefficients)-1
nb
## [1] 4
#Finalement, je vérifie à quelle probabilité la valeur 37.75 correspond dans une distribution de chi-carré avec 25 degrés de liberté (30 profils - 5 coefficients).
1-pchisq(s, (n_prof-nb-1))
## [1] 4.897134e-02 4.243958e-07

Interprétation: Le modèle n’est pas adéquat.

Avec seulement 108 observations pour 30 profils différents, il n’y a pas beaucoup d’observations par profil. Le test d’Hosmer-Lemeshow est donc probablement préférable.

  1. Dans ce cas, notez-vous un problème de sur-dispersion ou de sous-dispersion des données ? Cela-signifie que la variance observée est plus grande ou plus petite que la variance attendue?
dl <- n_prof-nb
disp <- s/dl
## [1] 1.45

Réponse: La somme des résiduels de Pearson (37.75) divisée par ses degrés de liberté (25) est > 1.0 et même que 1.2 (i.e. 37.75/25 = 1.51). Il y a donc sur-dispersion; la variance observée est plus grande que la variance attendue. Notez, cependant, que cela ne semble pas affecter l’adéquation du modèle (voir réponse précédente).

  1. La valeur prédictive d’un modèle peut également être évaluée à l’aide d’une courbe ROC. Représenter graphiquement la courbe ROC. Quel est l’aire sous la courbe pour votre modèle ? Quelle serait la sensibilité et la spécificité de votre modèle si on fixe un seuil de 50% (i.e. si modèle prédit probabilité de nocardiose > 50% alors on diagnostique le troupeau comme nocardia positif)?
library(broom)
diag <- augment(modele) #Je viens de créer une nouvelle table dans laquelle les résiduels, distance de cook, etc se trouvent maintenant

#Je vais ajouter les valeurs prédites de mon objet modele
diag$pred_prob <- modele$fitted.values

#Je génère l'objet ROC.
library(pROC)
roc_data <- roc(data=diag, response="casecont", predictor="pred_prob")

#Je génère la courbe ROC
plot.roc(roc_data, print.auc = TRUE, grid = TRUE)
**Figure x.** Courbe ROC.

Figure x. Courbe ROC.

Réponse: L’aire sous la courbe est 0.850. Avec un graphique interactif, ce sera facile de trouver les Se et Sp pour différent seuils.

library(plotly)
x_axis <- list(title = "Seuil de probabilité choisi")
y_axis <- list(title = "Précision")
plot_ly(
  x=round((1-roc_data$thresholds), digits=2),
  y=round(roc_data$sensitivities, digits=2),
  type="scatter",
  mode="line",
  name="Sensibilité"
) %>%
  add_trace(
    x=round((1-roc_data$thresholds), digits=2),
     y=round(roc_data$specificities, digits=2),
    name="Spécificité"
    )%>%
  
  layout(
    title="Précision du modèle",
    xaxis=x_axis,
    yaxis=y_axis
        )

Figure x. Sensibilité et spécificité en fonction du seuil choisi.

Réponse: Essayez l’onglet “Compare data on hover.” En se déplacant sur la figure on note des Se et Sp de 0.76 et 0.83, respectivement lorsqu’on fixe le seuil de probabilité à >0.50.

  1. Quel est le profil d’observations avec le résiduel de Pearson le plus élevé? Combien y-a-t’il d’observations dans ce profil?
#Je pourrais maintenant ordonner cette table pour voir les 10 observations avec les résiduels les plus larges
diag_maxres <- diag[order(-diag$.resid),]
head(diag_maxres, 10)
## # A tibble: 10 x 11
##    casecont dneo  dclox dcpct .fitted .resid .std.resid   .hat .sigma .cooksd
##    <fct>    <fct> <fct> <int>   <dbl>  <dbl>      <dbl>  <dbl>  <dbl>   <dbl>
##  1 1        0     0        10  -3.55    2.68       2.71 0.0243  0.971  0.178 
##  2 1        1     1        50  -1.57    1.87       1.93 0.0592  0.989  0.0641
##  3 1        0     0       100  -1.52    1.85       1.94 0.0901  0.988  0.0990
##  4 1        0     1        83  -1.45    1.82       1.89 0.0707  0.989  0.0700
##  5 1        0     1       100  -1.07    1.65       1.73 0.0847  0.992  0.0589
##  6 1        0     1       100  -1.07    1.65       1.73 0.0847  0.992  0.0589
##  7 1        1     0         1  -0.570   1.43       1.50 0.0893  0.996  0.0381
##  8 1        1     1       100  -0.437   1.37       1.42 0.0757  0.997  0.0275
##  9 1        1     1       100  -0.437   1.37       1.42 0.0757  0.997  0.0275
## 10 1        1     1       100  -0.437   1.37       1.42 0.0757  0.997  0.0275
## # ... with 1 more variable: pred_prob <dbl>

Réponse: Le modèle prédit une probabilité de moins de 3% de nocardiose dans un troupeau qui n’utilise ni neomycine, ni cloxacilline et ou 10% des vaches sont traitées au tarissement. Il y a une seule observation dans ce profil et il s’agit d’un troupeau positif à nocardia (d’où le résiduel très large).

  1. Quel profil d’observations avait le plus d’influence sur le coefficient de régression de dcpct? Pourquoi à votre opinion?
#Je pourrais maintenant ordonner cette table pour voir les 10 observations avec les leviers les plus larges
diag_cook <- diag[order(-diag$.cooksd),]
head(diag_cook, 10)
## # A tibble: 10 x 11
##    casecont dneo  dclox dcpct .fitted .resid .std.resid   .hat .sigma .cooksd
##    <fct>    <fct> <fct> <int>   <dbl>  <dbl>      <dbl>  <dbl>  <dbl>   <dbl>
##  1 1        0     0        10  -3.55    2.68       2.71 0.0243  0.971  0.178 
##  2 1        0     0       100  -1.52    1.85       1.94 0.0901  0.988  0.0990
##  3 1        0     1        83  -1.45    1.82       1.89 0.0707  0.989  0.0700
##  4 1        1     1        50  -1.57    1.87       1.93 0.0592  0.989  0.0641
##  5 1        0     1       100  -1.07    1.65       1.73 0.0847  0.992  0.0589
##  6 1        0     1       100  -1.07    1.65       1.73 0.0847  0.992  0.0589
##  7 1        1     0         1  -0.570   1.43       1.50 0.0893  0.996  0.0381
##  8 1        1     1       100  -0.437   1.37       1.42 0.0757  0.997  0.0275
##  9 1        1     1       100  -0.437   1.37       1.42 0.0757  0.997  0.0275
## 10 1        1     1       100  -0.437   1.37       1.42 0.0757  0.997  0.0275
## # ... with 1 more variable: pred_prob <dbl>

Réponse: C’est le même profil identifié à la question 5. En général, une augmentation de dcpct résulte en une augmentation de la probabilité de nocardia, mais cette observation à un dcpct bas (10% ; le 15ième plus bas du jeu de donnée), mais le troupeau était tout de même un troupeau cas. Ce profil tire donc la droite de régression vers lui (et modifie donc le coefficient de régression).

8 Régression pour données de compte et d’incidence

Les régressions pour données de compte et d’incidence (e.g. Poisson, binomiale négative, zero-inflated Poisson (ZIP) et zero-inflated binomiale negative (ZINB)) peuvent être réalisées dans R avec différentes librairies et fonctions.

La figure suivante schématise les différentes méthodes qui pourront être utilisées.

Figure. Méthodes de régression pour données de compte et d’incidence.

Le jeu de données tb_real.csv sera utilisé pour cette section.

#J'importe ce jeu de données
tb <-read.csv(file="tb_real.csv", header=TRUE, sep=";")
head(tb)
##   obs farm_id type sex age reactors  par
## 1   1    4002    2   0   0        1  525
## 2   2    4002    2   0   1        2 3675
## 3   3    4002    2   0   2        5 5775
## 4   4    4002    2   1   1        3 2625
## 5   5    4002    2   1   2        1  525
## 6   6    4003    2   0   2        2 7824
#J'indique les variables catégoriques dans mon jeu de données. Je vais aussi ajouter des étiquettes pour faciliter l'interprétation plus tard.
tb$farm_id <- factor(tb$farm_id) 
tb$type <- factor(tb$type, levels=c(1,2,3,4), labels=c("laitier","boucherie", "cervidé", "autre"))
tb$sex <- factor(tb$sex, levels=c(0,1), labels=c("femelle","mâle"))
tb$age <- factor(tb$age, levels=c(0:2), labels=c("0-12 mois","12-24 mois",">24 mois"))

8.1 Régression de Poisson

La fonction glm que vous avez déjà utilisée pour la régression logistique pourra effectuer la régression de Poisson lorsque la variable dépendante est simplement un compte d’événements, par exemple un nombre d’animaux positif à un test de tuberculine dans un troupeau (i.e. la variable reactors dans le jeu de données tb_real.csv) et qu’il n’y a pas de dénominateur à prendre en considération (i.e., que le nombre d’animal-temps à risque ne varie pas par troupeau). Dans ce cas, on aura qu’à indiquer la famille (family="poisson"). Notez que la fonction glm supposera automatiquement que la fonction de lien est le log et que la fonction de la variance est \(variance = moyenne\).

Par exemple, le modèle suivant permettrait d’effectuer une régression de Poisson avec les prédicteurs type, sex et age. D’abord en supposant que ce n’est pas nécessaire de prendre en compte un dénominateur (i.e. un nombre d’animal-temps à risque). Évidemment, cette supposition est incorrecte dans ce cas.

#En indiquant family="poisson", la fonction glm suppose une distribution de Poisson et un lien log
modele_incid<-glm(reactors~type+sex+age, family="poisson", data=tb)
summary(modele_incid)
## 
## Call:
## glm(formula = reactors ~ type + sex + age, family = "poisson", 
##     data = tb)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.2978  -1.4704  -0.4919  -0.1823   7.0686  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -2.4607     0.7333  -3.356 0.000792 ***
## typeboucherie  -0.4311     0.2359  -1.828 0.067579 .  
## typecervidé     0.3485     0.2237   1.558 0.119226    
## typeautre      -1.4651     0.6113  -2.397 0.016546 *  
## sexmâle        -1.2051     0.1850  -6.513 7.38e-11 ***
## age12-24 mois   3.0549     0.7219   4.232 2.32e-05 ***
## age>24 mois     3.8056     0.7121   5.344 9.10e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 664.82  on 133  degrees of freedom
## Residual deviance: 454.44  on 127  degrees of freedom
## AIC: 597.41
## 
## Number of Fisher Scoring iterations: 6

L’intercept et le coefficient de chacun des prédicteurs sont rapportés, de même que leur erreur-type, et la valeur de P correspondante.

8.1.1 Indiquer un Offset-dénominateur (e.g., nombre d’animal-temps à risque)

Souvent, un dénominateur (e.g. un nombre d’animal-temps à risque par unité d’étude) doit être pris en compte pour les données d’incidence ou de compte. Par exemple, dans le jeu de données tb_real.csv, la variable par représente le nombre d’animal-jour à risque par ferme et l’on voit que celui-ci varie passablement (de 30 à 118 084 animal-jour à risque). Bien sûr, ce ne serait pas valide de donner le même poids à des troupeaux avec des dénominateurs passablement différents (e.g. 3 positifs/30 animal-jours à risque est très différent de 3 positifs/118 084 animal-jour à risque). Dans ce cas, on devra indiquer au modèle une variable offset (i.e. un terme qui ne sert qu’à calibrer le poids de chaque observation et pour lequel aucun coefficient de régression n’est calculé). L’option offset() permettra d’indiquer la variable qui servira d’offset. Notez que, puisque la transformation logarithmique est utilisée comme fonction de lien pour la régression de compte et d’incidence, vous devrez d’abord transformer de la même façon (i.e. faire le log naturel) de votre variable qui représentait le nombre d’animal-jour à risque. Cette nouvelle variable représentera le log du nombre d’animal-jour à risque.

Par exemple, le modèle suivant permettrait d’effectuer une régression de Poisson en prenant en compte le dénominateur (i.e. le nombre d’animal-temps à risque ; variable par dans ce cas) de chacun des troupeaux. Ce modèle serait, évidemment, plus approprié dans notre cas.

#En premier lieu créons une variable offset qui représentera le nombre d'animaux-jour à risque, mais sur une échelle logarithmique
tb$log_par<-log(tb$par)

#Je dois indiquer cette variable directement dans le modèle avec +offset()
modele_incid<-glm(reactors~type+sex+age+offset(log_par), family="poisson", data=tb)
summary(modele_incid)
## 
## Call:
## glm(formula = reactors ~ type + sex + age + offset(log_par), 
##     family = "poisson", data = tb)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.5386  -0.8607  -0.3364  -0.0429   8.7903  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   -11.6899     0.7398 -15.802  < 2e-16 ***
## typeboucherie   0.4422     0.2364   1.871 0.061410 .  
## typecervidé     1.0662     0.2334   4.569 4.91e-06 ***
## typeautre       0.4384     0.6149   0.713 0.475898    
## sexmâle        -0.3619     0.1954  -1.852 0.064020 .  
## age12-24 mois   2.6734     0.7217   3.704 0.000212 ***
## age>24 mois     2.6012     0.7136   3.645 0.000267 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 409.03  on 133  degrees of freedom
## Residual deviance: 348.35  on 127  degrees of freedom
## AIC: 491.32
## 
## Number of Fisher Scoring iterations: 8

8.1.2 Test de rapport de vraisemblance

On pourra demander le test de rapport de vraisemblance comme vu en régression logistique.

library(lmtest)
lrtest(modele_incid)#teste le rapport de vraisemblance du modèle
## Likelihood ratio test
## 
## Model 1: reactors ~ type + sex + age + offset(log_par)
## Model 2: reactors ~ 1
##   #Df  LogLik Df  Chisq Pr(>Chisq)    
## 1   7 -238.66                         
## 2   1 -396.90 -6 316.47  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Dans ce cas, le modèle est significatif (P< 0.001).

8.1.3 Présenter les ratios d’incidence

En mettant à l’exposant les coefficients de régression, ils représenteront maintenant les ratio d’incidence (RI) lorsque une prédicteur continu augmente d’une unité ou pour un niveau d’un prédicteur catégorique comparativement au niveau de référence. Par exemple, ont pourrait demander ces coefficients transformés et leur intervalle de confiance.

library(jtools)
#J'utilises la librairie jtools pour obtenir une table avec mes coefficients et les IC95
j <- summ(modele_incid, confint = TRUE)
#J'utilises round pour ajuster la précision des valeurs dans les tables
round(exp(j$coeftable), digits=2)
##                Est. 2.5% 97.5% z val.    p
## (Intercept)    0.00 0.00  0.00   0.00 1.00
## typeboucherie  1.56 0.98  2.47   6.49 1.06
## typecervidé    2.90 1.84  4.59  96.42 1.00
## typeautre      1.55 0.46  5.17   2.04 1.61
## sexmâle        0.70 0.47  1.02   0.16 1.07
## age12-24 mois 14.49 3.52 59.62  40.61 1.00
## age>24 mois   13.48 3.33 54.59  38.28 1.00

Par exemple, le RI de boucherie comparativement à la valeur de référence laitier est de 1.56 (0.98, 2.47).

8.1.4 Calculer un compte prédit d’évènements

On pourra également demander le compte attendu d’évènements pour un individu avec un profil de prédicteurs donné. Il faudra alors simplement additionner l’intercept, puis les niveaux de prédicteurs qui nous intéresse et, ensuite, les mettre à l’exposant. Plus pratiquement, on pourra demander une prédiction pour une combinaison donnée. Par exemple, dans le code qui suit je génère un petit jeu de données qui contiendra les valeurs qui m’intéresse. Par exemple, troupeau laitier (type=1), femelle (sex=0) et 0-12 mois d’âge (age=0). J’ai aussi indiqué que la variable log_par (l’offset) prendrait la valeur log(100 000). On aura donc un compte d’évènements par 100 000 animaux-jours à risque.

Puis, je demande simplement la prédiction à l’aide de la fonction predict(). J’y indique l’objet modèle qui a préalablement été créé (modele_incid) et le petit jeu de données qui contient les valeurs que je viens de créer (new.tb). Il ne reste qu’à mettre le tout à l’exposant avec la fonction exp().

#Je génère le jeu de données avec les valeurs qui m'intéressent.
new.tb <- data.frame(type="laitier", sex="femelle", age="0-12 mois", log_par=(log(100000))) 

#Je génère la prédiction pour cette combinaison de prédicteurs.
exp(predict(modele_incid, newdata=new.tb))
##         1 
## 0.8378225

Le modèle prédit donc 0.84 cas de TB par 100 000 animaux-jours à risque chez les troupeaux de femelles laitière de 0-12 mois.

8.1.5 Comparer les niveaux d’un prédicteur catégorique avec > 2 catégories

Comme pour la régression logistique, les fonctions emmeans() et pairs() du package emmeans vous permet de comparer toutes les combinaisons possibles d’un ou plusieurs prédicteurs catégoriques et/ou quantitatifs.

Par exemple, le code suivant permet de comparer les catégories de la variable type entre elles. Notez que, en indiquant type="response", les résultats seront présentés sous forme de ratio d’incidence (RI). Ils sont aussi déjà ajustés pour les comparaisons multiples avec l’ajustement de Tukey-Kramer.

library(emmeans)
contrast <- emmeans(modele_incid, c("type")) 
confint(pairs(contrast, type="response"))
##  contrast            ratio     SE  df asymp.LCL asymp.UCL
##  laitier / boucherie 0.643 0.1519 Inf     0.350     1.180
##  laitier / cervidé   0.344 0.0804 Inf     0.189     0.627
##  laitier / autre     0.645 0.3967 Inf     0.133     3.131
##  boucherie / cervidé 0.536 0.0888 Inf     0.350     0.820
##  boucherie / autre   1.004 0.5958 Inf     0.219     4.612
##  cervidé / autre     1.874 1.1002 Inf     0.414     8.469
## 
## Results are averaged over the levels of: sex, age 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates 
## Intervals are back-transformed from the log scale

On note, par exemple, que les laitiers ont une incidence 0.64 fois plus faible (IC95: 0.35, 1.18) que les boucheries. Si vous voulez voir les comparaisons dans l’autre sens (boucherie comparé à laitier, plutôt que laitier comparé à boucherie), vous pouvez ajouter l’option reverse=TRUE dans la fonction pairs().

library(emmeans)
contrast <- emmeans(modele_incid, c("type")) 
confint(pairs(contrast, reverse=TRUE, type="response"))
##  contrast            ratio    SE  df asymp.LCL asymp.UCL
##  boucherie / laitier 1.556 0.368 Inf     0.848      2.86
##  cervidé / laitier   2.904 0.678 Inf     1.595      5.29
##  cervidé / boucherie 1.866 0.309 Inf     1.219      2.86
##  autre / laitier     1.550 0.953 Inf     0.319      7.52
##  autre / boucherie   0.996 0.591 Inf     0.217      4.58
##  autre / cervidé     0.534 0.313 Inf     0.118      2.41
## 
## Results are averaged over the levels of: sex, age 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates 
## Intervals are back-transformed from the log scale

8.1.6 Linéarité de la relation (pour prédicteur continu)

La linéarité de la relation est une supposition importante du modèle. Pour les prédicteurs continus, vous devrez toujours vérifier si cette supposition est bien respectée. Vous pouvez le faire simplement à l’aide du modèle polynomial comme vu précédemment (en ajoutant le \(prédicteur^2\) ou le \(prédicteur^2\) et le \(prédicteur^3\) dans votre modèle).

8.1.7 Test de chi-carré de Pearson

Comme vu en régression logistique, nous pouvons calculer la sommes des résiduels de \(Pearson^2\) de la façon suivante:

library(broom)
diag <- augment(modele_incid, type.residuals = "pearson") #Je viens de créer une nouvelle table avec les résiduels, etc. 

#Je calcule la somme de ces résiduels au carré. Dans ce cas, j'obtiens 1105.7
s <- sum(diag$.resid^2)
s
## [1] 1105.703
#Je vérifie à quelle probabilité la valeur 1105.7 correspond dans une distribution de chi-carré avec les degrés de liberté (n - le nombre de coefficients-1).
P <- 1-pchisq(s, (134-6-1))
P
## [1] 0
#Je peux aussi calculer le paramètre de dispersion
disp <- s/(134-6-1)
disp
## [1] 8.70632

Dans ce cas la valeur de P est très petite (i.e. P est près de 0), le test de \(chi^2\) de Pearson nous permet donc de conclure que le modèle n’est pas adéquat pour ces données. Il s’agit probablement d’un problème de surdispersion puisque la somme des résiduels de Pearson divisée par les ddl est égale à 8.7 (ce qui est beaucoup plus grand que 1.25). La variance est donc > que la moyenne dans ce jeu de données.

8.1.8 Profils extrêmes ou influents

Comme pour la régression logistique, vous pouvez demander de créer une nouvelle table contenant, en plus de vos variables originales, les différentes valeurs (e.g. résiduels de Pearson, de déviance, probabilité prédite, leviers) qui serviront à évaluer votre modèle. La fonction augment() du package broom vous permet de le faire. Vous pourrez ensuite trier cette table pour identifier, par exemple, les observations avec les résiduels, leviers ou distance de Cook les plus extrêmes et essayer de comprendre si ces observations ont quelque chose en commun.

library(broom)
diag <- augment(modele_incid) #Je viens de créer une nouvelle table dans laquelle les résiduels, distance de cook, etc se trouvent maintenant
head(diag)
## # A tibble: 6 x 11
##   reactors type   sex   age   `offset(log_par~ .fitted .resid .std.resid    .hat
##      <int> <fct>  <fct> <fct>            <dbl>   <dbl>  <dbl>      <dbl>   <dbl>
## 1        1 bouch~ feme~ 0-12~             6.26 -4.98    2.83       2.83  0.00352
## 2        2 bouch~ feme~ 12-2~             8.21 -0.365   1.27       1.29  0.0247 
## 3        5 bouch~ feme~ >24 ~             8.66  0.0148  2.82       2.85  0.0168 
## 4        3 bouch~ mâle  12-2~             7.87 -1.06    2.77       2.80  0.0217 
## 5        1 bouch~ mâle  >24 ~             6.26 -2.74    1.90       1.91  0.00324
## 6        2 bouch~ feme~ >24 ~             8.96  0.318   0.499      0.505 0.0228 
## # ... with 2 more variables: .sigma <dbl>, .cooksd <dbl>

Notez que les valeurs prédites sont sur une échelle de log(compte). Les valeurs prédites sur une échelle de compte par 1 animal-jour à risque ont cependant été conservées dans votre objet modèle. Vous pouvez donc simplement les ajouter à votre table de diagnostic, si vous le désirez. Vous pourriez aussi les multiplier par 100 000 pour avoir un taux par 100 000 animaux-jour (ou par 100 et par 365 pour un taux par 100 animaux-année).

diag$pred_count <- modele_incid$fitted.values
head(diag)
## # A tibble: 6 x 12
##   reactors type   sex   age   `offset(log_par~ .fitted .resid .std.resid    .hat
##      <int> <fct>  <fct> <fct>            <dbl>   <dbl>  <dbl>      <dbl>   <dbl>
## 1        1 bouch~ feme~ 0-12~             6.26 -4.98    2.83       2.83  0.00352
## 2        2 bouch~ feme~ 12-2~             8.21 -0.365   1.27       1.29  0.0247 
## 3        5 bouch~ feme~ >24 ~             8.66  0.0148  2.82       2.85  0.0168 
## 4        3 bouch~ mâle  12-2~             7.87 -1.06    2.77       2.80  0.0217 
## 5        1 bouch~ mâle  >24 ~             6.26 -2.74    1.90       1.91  0.00324
## 6        2 bouch~ feme~ >24 ~             8.96  0.318   0.499      0.505 0.0228 
## # ... with 3 more variables: .sigma <dbl>, .cooksd <dbl>, pred_count <dbl>

À partir de cette table, vous pourriez produire les graphiques qui vous intéresseront à l’aide de la fonction ggplot ou simplement classer la table pour voir les résiduels les plus grands, comme nous l’avos déjà fait précédemment.

8.1.9 Comparer les comptes observés et prédits

Vous pourrez représenter graphiquement les comptes observés vs. prédits de la manière suivante à l’aide des résultats de votre modèle et de la fonction ggplot() de la libraire ggplot2. Dans votre objet “modèle” la variable y représente le compte observé d’évènements et la variable fitted.values représente le compte prédit d’évènements. Vous pouvez les mettre ensemble dans une même base de données et ensuite produire des histogrammes pour chacune de ces valeurs ou encore, comme à la figure 18.2 du livre VER, un polygone de fréquence.

#En premier, je réunis les valeurs observées et prédites dans un jeu de données.
obs_pred <- data.frame(cbind(obs=modele_incid$y, pred=modele_incid$fitted.values))

#Ensuite je genère les deux polygones de fréquence dans une même figure.
library(ggplot2)
ggplot(data=obs_pred, mapping=aes(x=obs)) +
  geom_freqpoly(color="blue")+ #Je demande d'abbord une ligne pour les valeurs observées
  guides(color=FALSE) + #Je demande à ne pas avoir de légende dans ce cas
  geom_freqpoly(mapping=aes(x=pred, color="blue"))+ #Je demande ensuite une ligne pour les valeurs prédites
  xlim(0, NA)+ #J'enlève les valeurs sous zéro
  theme_bw() #Un thème blanc
**Figure.** Comparaison des comptes d'animaux réactifs observés (bleu) et prédits (rouge).

Figure. Comparaison des comptes d’animaux réactifs observés (bleu) et prédits (rouge).

Dans ce cas, on note un certain écart entre les comptes observés et prédits dans les troupeaux avec 0 animaux positifs (près de 87 troupeaux avaient 0 animaux positifs alors que le modèle prédit moins de troupeaux avec des comptes s’approchant de 0 positifs). Pour les autres valeurs, le modèle prédit des valeurs assez près des valeurs observées, mais est incapable de prédire des valeurs très élevées (e.g., 29 cas dans un troupeau).

8.1.10 Erreurs-type mise à l’échelle (scaled SE)

Une solution à la sur-dispersion est d’utiliser des erreurs-type mises à l’échelle (i.e. scaled SE). En fait, les erreurs-type sont alors simplement multipliées par la racine carrée du paramètre de dispersion de Pearson. Ce paramètre étant simplement la somme des résiduels de Pearson divisé par les degrés de liberté. En spécifiant family="quasipoisson" ce sera alors les erreurs-types mises à l’échelle qui vous seront présentées et qui serviront à calculer les IC95.

modele_scaled<-glm(reactors~type+sex+age+offset(log_par), family="quasipoisson", data=tb)
summary(modele_scaled)
## 
## Call:
## glm(formula = reactors ~ type + sex + age + offset(log_par), 
##     family = "quasipoisson", data = tb)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.5386  -0.8607  -0.3364  -0.0429   8.7903  
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -11.6899     2.1828  -5.355 3.87e-07 ***
## typeboucherie   0.4422     0.6976   0.634    0.527    
## typecervidé     1.0662     0.6886   1.548    0.124    
## typeautre       0.4384     1.8144   0.242    0.809    
## sexmâle        -0.3619     0.5765  -0.628    0.531    
## age12-24 mois   2.6734     2.1296   1.255    0.212    
## age>24 mois     2.6012     2.1057   1.235    0.219    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasipoisson family taken to be 8.706329)
## 
##     Null deviance: 409.03  on 133  degrees of freedom
## Residual deviance: 348.35  on 127  degrees of freedom
## AIC: NA
## 
## Number of Fisher Scoring iterations: 8

On note que les erreurs-type sont 2.9 fois plus grandes que ce qu’elles étaient. Notre facteur de dispersion était justement 8.7 et la racine carré de 8.7 est 2.9.

8.1.11 Variance robuste

Les erreurs-type robustes peuvent aussi être utilisées lorsqu’il y a problème de sur-dispersion (ou de nombreux autres problèmes comme la dépendance des données). La fonction sandwich() de la librairie sandwich permet de calculer la variance robuste pour mon modèle, j’obtiendrai les erreur-types robustes avec la racine carré de ces variances.

library(sandwich)
#Je demande la variance robuste
rob_var<-sandwich(modele_incid) 
#Les valeurs qui m'intéressent sont sur la diagonale, la fonction diag me permet de les isoler
rob_var<-diag(rob_var)
#Et maintenant je fais la racine carré
rob_SE <- sqrt(rob_var)

#Vous auriez aussi pu faire:
#rob_SE <-sqrt(diag(sandwich(modele_incid)))

#Pour faciliter la lecture, je pourrais ajouter ces erreur-types robustes à mes coefficients dans une table
tab_SE <- data.frame(cbind(Estimate=modele_incid$coefficients, robust_SE=rob_SE))

kable(round(tab_SE, digits=3), caption="**Table.** Modèle de Poisson avec erreur-types robustes.")%>%
  kable_styling()
Table. Modèle de Poisson avec erreur-types robustes.
Estimate robust_SE
(Intercept) -11.690 0.913
typeboucherie 0.442 0.456
typecervidé 1.066 0.496
typeautre 0.438 0.764
sexmâle -0.362 0.432
age12-24 mois 2.673 0.858
age>24 mois 2.601 0.854

Notez que, si vous désirez utiliser des erreurs-types robustes ET les intégrer dans un ajustement pour comparaisons multiples, c’est un peu plus compliqué. Vous devrez combiner la librairie multcomp et la librairie sandwich. J’utilises la fonction glht() de cette première librairie pour obtenir des comparaisons multiples et l’option vcov=sandwichpour utiliser la variance robuste.

library(multcomp)
library(sandwich)
#Ici je demande une comparaison multiple avec ajustement de Tukey et les erreur-types robustes
tukey <- glht(modele_incid, linfct = mcp(type="Tukey", age="Tukey", sex="Tukey") , vcov = sandwich)

#J'ajoute les IC95
with_ci <- confint(tukey)

#Je les transforme en IR
tukey_results <- exp(with_ci$confint)

#Je présente la table en arrondissant les IR à 2 décimales.
kable(round(tukey_results, digits=2), caption="**Table.** IR du modèle de Poisson avec erreur-types robustes et IC95 ajustées pour comparaisons multiples.")%>%
  kable_styling()
Table. IR du modèle de Poisson avec erreur-types robustes et IC95 ajustées pour comparaisons multiples.
Estimate lwr upr
type: boucherie - laitier 1.56 0.45 5.40
type: cervidé - laitier 2.90 0.75 11.26
type: autre - laitier 1.55 0.19 12.50
type: cervidé - boucherie 1.87 0.49 7.11
type: autre - boucherie 1.00 0.12 8.39
type: autre - cervidé 0.53 0.07 4.25
age: 12-24 mois - 0-12 mois 14.49 1.39 150.93
age: >24 mois - 0-12 mois 13.48 1.31 138.89
age: >24 mois - 12-24 mois 0.93 0.31 2.82
sex: mâle - femelle 0.70 0.21 2.27

8.2 Régression binomiale négative

Pour effectuer une régression binomiale négative, vous devez utiliser la fonction glm.nb() de la librairie MASS comme suit.

library(MASS)
modele_nb<-glm.nb(reactors~type+sex+age+offset(log_par), data=tb)
summary(modele_nb)
## 
## Call:
## glm.nb(formula = reactors ~ type + sex + age + offset(log_par), 
##     data = tb, init.theta = 0.5745887328, link = log)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.77667  -0.74441  -0.45509  -0.09632   2.70012  
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   -11.18145    0.92302 -12.114  < 2e-16 ***
## typeboucherie   0.60461    0.62282   0.971 0.331665    
## typecervidé     0.66572    0.63176   1.054 0.291993    
## typeautre       0.80003    0.96988   0.825 0.409442    
## sexmâle        -0.05748    0.38337  -0.150 0.880819    
## age12-24 mois   2.25304    0.77915   2.892 0.003832 ** 
## age>24 mois     2.48095    0.75283   3.296 0.000982 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for Negative Binomial(0.5746) family taken to be 1)
## 
##     Null deviance: 111.33  on 133  degrees of freedom
## Residual deviance:  99.36  on 127  degrees of freedom
## AIC: 331.47
## 
## Number of Fisher Scoring iterations: 1
## 
## 
##               Theta:  0.575 
##           Std. Err.:  0.143 
## 
##  2 x log-likelihood:  -315.472

Le paramètre de dispersion (Theta) et son erreur-type sont rapportés en bas.

8.2.1 Comparer les modèles Poisson et Binomial négatif

Un test de rapport de vraisemblance peut être utilisé pour vérifier si l’ajout du facteur de dispersion est statistiquement significatif (i.e., pour vérifier si le modèle Binomial négatif est statistiquement meilleur que le Poisson).

library(lmtest)
lrtest(modele_incid, modele_nb)
## Likelihood ratio test
## 
## Model 1: reactors ~ type + sex + age + offset(log_par)
## Model 2: reactors ~ type + sex + age + offset(log_par)
##   #Df  LogLik Df  Chisq Pr(>Chisq)    
## 1   7 -238.66                         
## 2   8 -157.74  1 161.85  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Dans ce cas, on note que l’ajout du facteur de dispersion est statistiquement significatif (P < 0.001).

8.2.2 Évaluer les résiduels d’un modèle Binomial négatif

Malheureusement, la librairie broom que nous avons utilisée jusqu’à présent pour générer une table de diagnostic ne fonctionne plus avec le modèle Binomial négatif estimé avec la fonction glm.nb() de la librairie MASS. Ces résiduels peuvent cependant être générés avec la fonction simulateResiduals() de la librairieDHARMa. Je la connais peu, voici quelques possibilités, je vous laisse la découvrir.

library(DHARMa)
#Permet de générer des résiduels par simulation
negbin_simulation <- simulateResiduals(fittedModel = modele_nb)

#Permet de visualiser les résiduels vs les valeurs prédites.
plotSimulatedResiduals(simulationOutput = negbin_simulation)

#Permet de tester avec le Pearson chi-square test s'il y a surdispersion 
testDispersion(negbin_simulation, type="PearsonChisq")
## 
##  Parametric dispersion test via mean Pearson-chisq statistic
## 
## data:  negbin_simulation
## dispersion = 2.9516, df = 127, p-value < 2.2e-16
## alternative hypothesis: two.sided

Dans ce cas, il semble y avoir encore une très légère surdispersion (Pearson/DDL=1.27 > 1.25)…

8.3 Modèles zéro-enflés

8.3.1 Généralités

Parfois le nombre de zéros est plus grand ou plus petit que ce que l’on attend avec une distribution de Poisson ou Binomiale négative. On peut alors avoir recours à un modèle pour excès de zéros (un modèle zéros-enflé de Poisson ou zéro-enflé Binomial négatif, respectivement abbréviés ZIP ou ZINB) ou le modèle à barrière (hurdle model). S’il n’y a pas de zéros, on peut alors utiliser un modèle à zéros tronqués (zero-truncated model) ou simplement soustraire la valeur 1 de note variable dépendante.

Pour cette section, nous travaillerons avec la base de données fec.csv. Celle-ci décrit le nombre d’oeufs de parasite/5g de fèces en fonction de différents prédicteurs. Dans cet exemple, il n’y a pas de dénominateur à prendre en compte (i.e. pas de variable offset).

#J'importe la base de données
fec <-read.csv(file="fec.csv", header=TRUE, sep=";")

#Je recode certaines variables
fec$fec<-as.numeric(fec$fec)
fec$lact<-as.factor(fec$lact)
fec$past_lact<-as.factor(fec$past_lact)
fec$man_heif<-as.factor(fec$man_heif)
fec$man_lact<-as.factor(fec$man_lact)

#Visualisons la base de données
head(fec)
##   province herd cow visit tx fec lact season past_lact man_heif man_lact
## 1        1    1  46     5  0   3    1      2         1        0        0
## 2        1    1  46     6  0   3    1      2         1        0        0
## 3        1    1  46     7  0  11    1      2         1        0        0
## 4        1    1  46     8  0   7    1      3         1        0        0
## 5        1    1  46     9  0  17    1      3         1        0        0
## 6        1    1  46    10  0   6    1      3         1        0        0
#Distribution de notre variable dépendante (fec)
library(ggplot2)
ggplot(fec, aes(x=fec)) +
  geom_histogram(colour="black", fill="grey")+
  theme_bw() +
  xlab("Nombre d'oeufs/5g de fèces")+
  ylab("Nombre de vache")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

On note une distribution qui s’étire vers la droite et avec beaucoup de vaches avec la valeur zéro.

La fonction zeroinfl() de la librairie pscl permettra de générer les modèles zéros-enflés de Poisson ou Binomial négatif. Les modèles pour excès de zéros travaillent en appliquant simultanément une régression logistique et une régression de Poisson (ou Binomiale négative). Les deux modèles peuvent avoir les mêmes prédicteurs mais ce n’est pas obligatoire. Notez que la régression logistique donne la probabilité d’avoir un compte de zéro (et donc les coefficients ont un signe opposé à ce qu’ils auraient dans une régression logistique « traditionnelle »).

Le code suivant permet d’évaluer un modèle zéros-enflés Binomial négatif évaluant l’effet de différents prédicteurs (lact= multipare, past_lac= accès au pâturage, man_heif= fumier étendu sur pâturage des taures, man_lac=fumier étendu sur pâturage des vaches adultes) sur le compte d’œufs de parasites/5g de fèces.

library(pscl)
modele_zinb<-zeroinfl(fec ~ lact + past_lact + man_heif + man_lact, dist="negbin", data=fec)
summary(modele_zinb)
## 
## Call:
## zeroinfl(formula = fec ~ lact + past_lact + man_heif + man_lact, data = fec, 
##     dist = "negbin")
## 
## Pearson residuals:
##     Min      1Q  Median      3Q     Max 
## -0.5055 -0.4537 -0.3624 -0.1425 27.3062 
## 
## Count model coefficients (negbin with log link):
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  2.36949    0.13117  18.064  < 2e-16 ***
## lact1       -1.15848    0.10664 -10.864  < 2e-16 ***
## past_lact1   0.53667    0.14233   3.771 0.000163 ***
## man_heif1   -0.99846    0.14216  -7.023 2.16e-12 ***
## man_lact1    1.07856    0.15789   6.831 8.43e-12 ***
## Log(theta)  -1.35981    0.05425 -25.065  < 2e-16 ***
## 
## Zero-inflation model coefficients (binomial with logit link):
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -0.9303     0.2932  -3.173  0.00151 ** 
## lact1         0.8700     0.3083   2.822  0.00478 ** 
## past_lact1   -1.8003     0.3990  -4.512 6.41e-06 ***
## man_heif1    -0.7701     0.4669  -1.649  0.09905 .  
## man_lact1   -12.0963   156.4271  -0.077  0.93836    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
## 
## Theta = 0.2567 
## Number of iterations in BFGS optimization: 47 
## Log-likelihood: -5239 on 11 Df

Notez que les résultats présentés sont passablement différents. Vous avez deux tables avec les estimés des paramètres, une pour la partie binomiale négative (i.e. les comptes) et une pour la partie zéros-enflés (i.e. la partie binomiale / logistique ou, si vous préférez, l’excès de zéros).

On pourrait ajouter nos IC95 et mettre nos coefficients à l’exposant pour mieux visualiser les résultats. Notez que la librairie jtools (qui faisait automatiquement de jolies tables de résultats) ne fonctionne pas avec ce genre de modèle. Dommage…

# LA PARTIE LOGISTIQUE
# Extraire les coefficients et les erreurs types de la partie logistique (binomiale) du modèle dans une même table
coefs_logi <- as.data.frame(summary(modele_zinb)$coefficients$zero[,1:2])
names(coefs_logi)[2] = "SE"
# Calculer les IC95
coefs_logi$lower.ci <- coefs_logi$Estimate-1.96*coefs_logi$SE
coefs_logi$upper.ci <- coefs_logi$Estimate+1.96*coefs_logi$SE
#Ici ont pourrait déjà renverser tout les coefficients et les CI

# Mettre à l'exposant les coefficients
OR <- exp(coefs_logi)
# Retirer l'intercept (la 1ère rangée) et les erreurs-types
OR <- OR[-c(1), ]
OR <- subset(OR, select = -c(SE))


# LA PARTIE COMPTE
# Extraire les coefficients et les erreurs types de la partie Binomiale négative du modèle dans une même table
coefs <- as.data.frame(summary(modele_zinb)$coefficients$count[,1:2])
names(coefs)[2] = "SE"
# Calculer les IC95
coefs$lower.ci <- coefs$Estimate-1.96*coefs$SE
coefs$upper.ci <- coefs$Estimate+1.96*coefs$SE
# Mettre à l'exposant les coefficients
IR <- exp(coefs)
# Retirer l'intercept (la 1ère rangée), le paramètre de dispersion (la 6ième rangée) et les erreurs-types
IR <- IR[-c(1, 6), ]
IR <- subset(IR, select=-c(SE))


#Finalement, on pourra demander à voir ces tables
library(knitr)
kable(round(OR, digits=2), caption="**Table.** Partie logistique du modèle zéro-enflé Binomial négatif (ZINB).")%>%
  kable_styling()
Table. Partie logistique du modèle zéro-enflé Binomial négatif (ZINB).
Estimate lower.ci upper.ci
lact1 2.39 1.30 4.370000e+00
past_lact1 0.17 0.08 3.600000e-01
man_heif1 0.46 0.19 1.160000e+00
man_lact1 0.00 0.00 7.945616e+127 
kable(round(IR, digits=2), caption="**Table.** Partie binomiale négative du modèle zéro-enflé Binomial négatif (ZINB).")%>%
  kable_styling()
Table. Partie binomiale négative du modèle zéro-enflé Binomial négatif (ZINB).
Estimate lower.ci upper.ci
lact1 0.31 0.25 0.39
past_lact1 1.71 1.29 2.26
man_heif1 0.37 0.28 0.49
man_lact1 2.94 2.16 4.01

L’interprétation des coefficients de régression, par exemple pour la variable lact (primipare=0 est la valeur de référence et multipare=1) se fera comme suit : Les vaches multipares avaient 2.4 fois (IC95: 1.3, 4.4) les odds d’avoir aucun œufs de parasites dans leurs fèces comparativement aux primipares et elles avaient 0.31 fois (IC95: 0.25, 0.39) le compte d’œufs de parasites des primipares.

Bien sûr, vous pouvez encore utiliser certaines fonctions que vous avez maintenant l’habitude d’utiliser, par exemple les fonction emmeans() et pairs du package emmeans .

8.3.2 Test de Vuong – Comparer modèle zéros-enflés au modèle régulier

On peut vérifier si un modèle pour excès de zéros est plus approprié que le modèle de Poisson ou Binomial négatif équivalent grâce au test de Vuong. Pour ce faire, on devra d’abbord générer un objet modèle Poisson et un autre objet modèle zéro-enflé Poisson (ou un Binomial négatif et un zéro-enflé Binomial négatif). Ensuite, la fonction vuong() de la librairie pscl permettra de comparer ces modèles.

# Le modèle NB
library(MASS)
modele_nb <- glm.nb(fec ~ lact + past_lact + man_heif + man_lact, data=fec) 

# Le modèle ZINB
library(pscl)
modele_zinb<-zeroinfl(fec ~ lact + past_lact + man_heif + man_lact, dist="negbin", data=fec)

#Le test de Vuong
vuong(modele_nb, modele_zinb)
## Vuong Non-Nested Hypothesis Test-Statistic: 
## (test-statistic is asymptotically distributed N(0,1) under the
##  null that the models are indistinguishible)
## -------------------------------------------------------------
##               Vuong z-statistic             H_A    p-value
## Raw                  -3.3087359 model2 > model1 0.00046859
## AIC-corrected        -2.6889996 model2 > model1 0.00358332
## BIC-corrected        -0.9169612 model2 > model1 0.17958149

Trois tests statistiques différents sont réalisés. Dans tous les cas le modèle zéros-enflés (le #2) semble préférable et deux de ces tests indiquent une différence statistiquement significative entre les modèles ZINB et NB.

8.4 Calcul du risque relatif à l’aide d’une régression de Poisson

Avec une variable dépendante qui ne peut prendre que 2 valeurs (0/1), on utilise en général la régression logistique et ont présente donc un rapport de cotes (i.e. un odds ratio). Dans certaines situations, cependant, on préfèrerait présenter un risque relatif plutôt qu’un rapport de côtes. Par exemple, pour faciliter la compréhension des résultats (i.e. le risque relatif est plus facile à comprendre que le rapport de cotes) ou pour permettre le calcul d’autres mesures d’association (e.g. la fraction attribuable dans la population).

Si la maladie est rare (prévalence < 5%), le rapport de cotes ≈ le risque relatif. Mais si la maladie est relativement fréquente, on ne pourra se servir de cette particularité. On peut, cependant, utiliser une régression de Poisson et un lien log avec une variable dépendante binaire. L’exposant des coefficients sera alors un risque relatif (plutôt qu’un rapport de cotes). Les IC 95% seront, cependant, un peu trop conservateurs (i.e. trop larges). On pourra y remédier en utilisant des erreurs-types robustes. Voir (Barros et Hirakata, 2003.7 pour plus de détails.

Le code suivant permet de calculer des risques relatifs (plutôt que des rapports de cotes) pour le risque de Nocardiose en fonction des traitements au tarissement utilisés.

#J'importe le jeu de données
nocardia <-read.csv(file="nocardia.csv", header=TRUE, sep=";")

#J'indique les variables catégoriques dans mon jeu de données
nocardia$dbarn <- factor(nocardia$dbarn) 
nocardia$dneo <- factor(nocardia$dneo) 
nocardia$dclox <- factor(nocardia$dclox) 

#J'effectue une régression de Poisson avec variance robuste
modele_poisson <- glm(casecont ~ dclox + dneo + dcpct, family="poisson", data=nocardia)

#Je demande la variance robuste
library(sandwich)
rob_SE <-sqrt(diag(sandwich(modele_poisson)))

#Pour faciliter la lecture, je pourrais ajouter ces erreur-types robustes à mes coefficients dans une table
tab_SE <- data.frame(cbind(Estimate=modele_poisson$coefficients, robust_SE=rob_SE))

#Puis calculer les IC95
tab_SE$lower.ci <- tab_SE$Estimate-1.96*tab_SE$robust_SE
tab_SE$upper.ci <- tab_SE$Estimate+1.96*tab_SE$robust_SE

#Enlever l'intercept, les SE et mettre tout à l'exposant pour avoir des RR 
tab_SE <- tab_SE[-c(1), ]
tab_SE <- exp(subset(tab_SE, select=-c(robust_SE)))

library(knitr)
kable(round(tab_SE, digits=2), caption="**Table.** Modèle de Poisson avec erreur-types robustes pour estimer le risque relatif de Nocardiose.")%>%
  kable_styling()
Table. Modèle de Poisson avec erreur-types robustes pour estimer le risque relatif de Nocardiose.
Estimate lower.ci upper.ci
dclox1 0.56 0.31 1.02
dneo1 3.56 1.55 8.14
dcpct 1.01 1.00 1.02

Le risque relatif (RR) de Nocardiose dans les troupeaux utilisant la néomycine (vs. ceux qui ne l’utilisaient pas) était est donc de 3.56 (IC95: 1.55, 8.14).

8.5 Travaux pratiques 6 - Régression de Poisson et Binomiale négative

8.5.1 Exercices

Pour ce TP utilisez le fichier TB_real (voir description VER p.836).

Dans cette étude nous sommes intéressés à décrire les facteurs de risque associés à l’incidence d’animaux positifs à la tuberculose. L’incidence est définie à l’aide des variables reactors (le nombre d’animaux positif sur une ferme) et par (le nombre d’animal-jour à risque sur cette ferme).

  1. Quel genre de valeurs la variable reactors prend-t’elle? Évaluer graphiquement la distribution de la variable reactors. Quel genre de distribution la variable reactors semble-t’elle suivre ? Justifiez.

  2. Évaluez graphiquement la distribution du nombre d’animal-jour à risque (variable par). Y-a-t’il beaucoup de variation d’une ferme à l’autre ? Comment pourrez-vous tenir compte de ces différences dans un modèle de régression de Poisson ?

  3. Évaluer l’effet du type d’élevage (i.e. la variable type) sur l’incidence d’animaux positifs à la tuberculose (reactors) tout en prenant en compte les nombres différents d’animal-jour à risque dans chacune des fermes.

3.1. Est-ce que la variable type est significativement associée à l’incidence de tuberculose (i.e. est-ce qu’au moins un des coefficients de régression des variables indicateurs est différent de zéro)?

3.2. Quels sont les ratios d’incidence, leurs IC 95% et les valeurs de P pour chacun des types d’élevage (utilisez laitier comme valeur de référence)?

3.3. Comment interprétez-vous le ratio d’incidence des cervidés?

3.4. Bien certainement, vous vous rappelez que vous devez ajuster ces IC 95% et valeurs de P pour les comparaisons multiples… Effectuez cet ajustement à l’aide de la méthode Tukey-Kramer. Les IC 95% et valeurs de P sont-elles maintenant plus grandes ou plus petites?

3.5. Est-ce que ce modèle semble adéquat pour ces données?

3.6. Y-a-t’il surdispersion? Si c’est le cas, quelles options avez-vous afin d’améliorer votre modèle?

3.7. Évaluez les ratios d’incidence, leurs IC 95% et les valeurs de P pour chacun des types d’élevage, mais à l’aide des erreurs-type robustes et en ajustant pour les comparaisons multiple. Est-ce que la variable type est toujours significativement associée à l’incidence de tuberculose (i.e. est-ce qu’au moins un des coefficients de régression des variables indicateurs est différent de zéro)?

3.8. Un modèle de régression binomiale négative permettrait peut-être de modéliser correctement cette surdispersion. Évaluez un tel modèle. Est-ce que le paramètre de dispersion semble significativement différent de zéro? Effectuez un test de rapport de vraisemblance comparant les modèles de régression binomial négative et de Poisson.

3.9. Comparez graphiquement le compte d’animaux positifs à la tuberculose prédits par ce dernier modèle et les comptes réel d’animaux positifs. Que notez-vous?

8.5.2 Code R et réponses

Pour ce TP utilisez le fichier TB_real (voir description VER p.836).

#J'importe ce jeu de données
tb <-read.csv(file="tb_real.csv", header=TRUE, sep=";")
head(tb)
##   obs farm_id type sex age reactors  par
## 1   1    4002    2   0   0        1  525
## 2   2    4002    2   0   1        2 3675
## 3   3    4002    2   0   2        5 5775
## 4   4    4002    2   1   1        3 2625
## 5   5    4002    2   1   2        1  525
## 6   6    4003    2   0   2        2 7824
#J'indique les variables catégoriques dans mon jeu de données. Je vais aussi ajouter des étiquettes pour faciliter l'interprétation plus tard.
tb$farm_id <- factor(tb$farm_id) 
tb$type <- factor(tb$type, levels=c(1,2,3,4), labels=c("laitier","boucherie", "cervidé", "autre"))
tb$sex <- factor(tb$sex, levels=c(0,1), labels=c("femelle","mâle"))
tb$age <- factor(tb$age, levels=c(0:2), labels=c("0-12 mois","12-24 mois",">24 mois"))

Dans cette étude nous sommes intéressés à décrire les facteurs de risque associés à l’incidence d’animaux positifs à la tuberculose. L’incidence est définie à l’aide des variables reactors (le nombre d’animaux positif sur une ferme) et par (le nombre d’animal-jour à risque sur cette ferme).

  1. Quel genre de valeurs la variable reactors prend-t’elle? Évaluer graphiquement la distribution de la variable reactors. Quel genre de distribution la variable reactors semble-t’elle suivre ? Justifiez.
library(summarytools)
print(dfSummary(tb$reactors), method='render')
## tb$reactors was converted to a data frame

Data Frame Summary

tb

Dimensions: 134 x 1
Duplicates: 121
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 reactors [integer] Mean (sd) : 1.5 (4) min < med < max: 0 < 0 < 29 IQR (CV) : 1 (2.8) 13 distinct values 134 (100.0%) 0 (0.0%)

Generated by summarytools 0.9.8 (R version 4.0.4)
2022-02-11

Réponse: reactors ne prend que des valeurs entières positives (0, 1, 2, 3, …). reactors représente des données de comptes et semble suivre une distribution de Poisson: -les données de petite valeur sont fréquentes (0, 1, 2), -à partir d’une certaine valeur, la fréquence décroît rapidement,

  1. Évaluez graphiquement la distribution du nombre d’animal-jour à risque (variable par). Y-a-t’il beaucoup de variation d’une ferme à l’autre ? Comment pourrez-vous tenir compte de ces différences dans un modèle de régression de Poisson ?
library(summarytools)
print(dfSummary(tb$par), method='render')
## tb$par was converted to a data frame

Data Frame Summary

tb

Dimensions: 134 x 1
Duplicates: 14
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 par [numeric] Mean (sd) : 7968.6 (15878.1) min < med < max: 30 < 2135.5 < 118084 IQR (CV) : 7149 (2) 120 distinct values 134 (100.0%) 0 (0.0%)

Generated by summarytools 0.9.8 (R version 4.0.4)
2022-02-11

Réponse: Oui, beaucoup de fermes ont peu d’animal-jour à risque (i.e. elles comptaient peu d’animaux et/ou elles avaient été suivies pendant peu de jours) alors que d’autres ont des valeurs de par élevées. Ces différences pourraient être gérées dans une régression de Poisson en spécifiant une variable offset qui sera en fait le logarithme naturel de par.

  1. Évaluer l’effet du type d’élevage (i.e. la variable type) sur l’incidence d’animaux positifs à la tuberculose (reactors) tout en prenant en compte les nombres différents d’animal-jour à risque dans chacune des fermes.
#Je dois d'abord créer un offset en transformant la variable "par" sur une échelle logarithmique
tb$log_par <- log(tb$par)

#Ensuite je génère un objet modèle, pour une régression de Poisson, le prédicteur "type" et le offset "log_par"
modele_incid<-glm(reactors~type+offset(log_par), family="poisson", data=tb)

3.1. Est-ce que la variable type est significativement associée à l’incidence de tuberculose (i.e. est-ce qu’au moins un des coefficients de régression des variables indicateurs est différent de zéro)?

summary(modele_incid)
## 
## Call:
## glm(formula = reactors ~ type + offset(log_par), family = "poisson", 
##     data = tb)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.7137  -1.1568  -0.4825  -0.1190   9.0537  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -9.1000     0.2000 -45.500  < 2e-16 ***
## typeboucherie   0.3294     0.2353   1.400 0.161603    
## typecervidé     0.8122     0.2232   3.639 0.000273 ***
## typeautre       0.3063     0.6110   0.501 0.616102    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 409.03  on 133  degrees of freedom
## Residual deviance: 390.50  on 130  degrees of freedom
## AIC: 527.47
## 
## Number of Fisher Scoring iterations: 6

Réponse: Ici ont voit que cervidés semble différent de la valeur de référence (laitier). Mais ce serait préférable de faire un test de rapport de vraisemblance sur l’ensemble des variables indicateurs.

library(lmtest)
lrtest(modele_incid)#teste le rapport de vraisemblance du modèle
## Likelihood ratio test
## 
## Model 1: reactors ~ type + offset(log_par)
## Model 2: reactors ~ 1
##   #Df  LogLik Df  Chisq Pr(>Chisq)    
## 1   4 -259.74                         
## 2   1 -396.90 -3 274.32  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Réponse: Le test de rapport de vraisemblance comparant le modèle avec la variable type et sans celle-ci est significatif (P<0.001).

3.2. Quels sont les ratios d’incidence et leurs IC 95% pour chacun des types d’élevage (utilisez laitier comme valeur de référence)?

#Comme laitier est déjà la valeur de référence, je peux simplement faire:
library(jtools)
#J'utilises la librairie jtools pour obtenir une table avec mes coefficients et les IC95
j <- summ(modele_incid, confint = TRUE)
#J'utilises round pour ajuster la précision des valeurs dans les tables
round(exp(j$coeftable), digits=2)
##               Est. 2.5% 97.5% z val.    p
## (Intercept)   0.00 0.00  0.00   0.00 1.00
## typeboucherie 1.39 0.88  2.20   4.05 1.18
## typecervidé   2.25 1.45  3.49  38.07 1.00
## typeautre     1.36 0.41  4.50   1.65 1.85

Réponse: Pour ce calcul, on aurait aussi pu simplement faire l’exposant des coefficients et des IC 95% rapportés à l’aide de ma fonction summary().

3.3. Comment interprétez-vous le ratio d’incidence des cervidés?

Réponse: L’incidence de tuberculose est 2.25 fois plus élevée dans les élevages de cervidés comparativement aux élevages laitiers.

3.4. Bien certainement, vous vous rappelez que vous devez ajuster ces IC 95% et valeurs de P pour les comparaisons multiples… Effectuez cet ajustement à l’aide de la méthode Tukey-Kramer. Les IC 95% sont-elles maintenant plus grands ou plus petits?

library(emmeans)
contrast <- emmeans(modele_incid, c("type")) 
#Notez ici, j'ai ajouté l'option "reverse=TRUE" pour présenter les comparaisons dans l'autre sens (i.e., comme dans mon summary()). 
confint(pairs(contrast, reverse = TRUE, type="response"))
##  contrast            ratio    SE  df asymp.LCL asymp.UCL
##  boucherie / laitier 1.390 0.327 Inf     0.759      2.54
##  cervidé / laitier   2.253 0.503 Inf     1.270      4.00
##  cervidé / boucherie 1.621 0.257 Inf     1.078      2.44
##  autre / laitier     1.358 0.830 Inf     0.283      6.53
##  autre / boucherie   0.977 0.577 Inf     0.214      4.45
##  autre / cervidé     0.603 0.353 Inf     0.134      2.72
## 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates 
## Intervals are back-transformed from the log scale

Réponse: Bien évidemment les IC 95% sont plus larges (par exemple 0.76, 2.5 après ajustement pour les comparaisons multiples vs. 0.88, 2.2).

3.5. Est-ce que ce modèle semble adéquat pour ces données?

library(broom)
diag <- augment(modele_incid, type.residuals = "pearson") #Je viens de créer une nouvelle table avec les résiduels, etc. 

#Je calcule la somme de ces résiduels au carré. Dans ce cas, j'obtiens 791.0
s <- sum(diag$.resid^2)
s
## [1] 791.0448
#Je vérifie à quelle probabilité la valeur 791.0 correspond dans une distribution de chi-carré avec les degrés de liberté (n - le nombre de coefficients-1).
P <- 1-pchisq(s, (134-3-1))
P
## [1] 0

Réponse: Le test de \(X^2\) de Pearson donne une valeur de P < 0.001, l’hypothèse nulle doit donc être rejetée, le modèle n’est pas adéquat pour les données.

3.6. Y-a-t’il surdispersion? Si c’est le cas, quelles options avez-vous afin d’améliorer votre modèle?

#Je peux calculer le paramètre de dispersion
disp <- s/(134-3-1)
disp
## [1] 6.08496

Réponse: La somme des résiduels de Pearson/ddl = 6.08, il y a donc surdispersion (i.e. >1.25). Plusieurs options permettraient de contrôler ce problème, entre autres l’utilisation d’erreurs-type « scaled » ou robustes ou l’utilisation d’un modèle de régression binomiale négative.

3.7. Évaluez les ratios d’incidence, leurs IC 95% et les valeurs de P pour chacun des types d’élevage, mais à l’aide des erreurs-type robustes et en ajustant pour les comparaisons multiple. Est-ce que la variable type est toujours significativement associée à l’incidence de tuberculose (i.e. est-ce qu’au moins un des coefficients de régression des variables indicateurs est différent de zéro)?

library(multcomp)
library(sandwich)
#Ici je demande une comparaison multiple avec ajustement de Tukey et les erreur-types robustes
tukey <- glht(modele_incid, linfct = mcp(type="Tukey") , vcov = sandwich)

#J'ajoute les IC95
with_ci <- confint(tukey)

#Je les transforme en IR
tukey_results <- exp(with_ci$confint)

#Je présente la table en arrondissant les IR à 2 décimales.
kable(round(tukey_results, digits=2), caption="**Table.** IR du modèle de Poisson avec erreur-types robustes et IC95 ajustées pour comparaison multiples.")%>%
  kable_styling()
Table. IR du modèle de Poisson avec erreur-types robustes et IC95 ajustées pour comparaison multiples.
Estimate lwr upr
boucherie - laitier 1.39 0.46 4.23
cervidé - laitier 2.25 0.77 6.62
autre - laitier 1.36 0.23 8.01
cervidé - boucherie 1.62 0.50 5.23
autre - boucherie 0.98 0.16 6.11
autre - cervidé 0.60 0.10 3.69

Réponse: Non la variable type n’est plus associée à l’incidence de tuberculose.

3.8. Un modèle de régression binomiale négative permettrait peut-être de modéliser correctement cette surdispersion. Évaluez un tel modèle. Est-ce que le paramètre de dispersion semble significativement différent de zéro? Effectuez un test de rapport de vraisemblance comparant les modèles de régression binomial négative et de Poisson.

#Le modèle Binomial négatif
modele_nb<-glm.nb(reactors~type+offset(log_par), data=tb)
summary(modele_nb)
## 
## Call:
## glm.nb(formula = reactors ~ type + offset(log_par), data = tb, 
##     init.theta = 0.4472788933, link = log)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5695  -0.8400  -0.5043  -0.1769   2.6508  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -8.8516     0.5846 -15.143   <2e-16 ***
## typeboucherie   0.5412     0.6461   0.838    0.402    
## typecervidé     0.5163     0.6441   0.801    0.423    
## typeautre       0.8685     1.0054   0.864    0.388    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for Negative Binomial(0.4473) family taken to be 1)
## 
##     Null deviance: 98.108  on 133  degrees of freedom
## Residual deviance: 97.297  on 130  degrees of freedom
## AIC: 335.44
## 
## Number of Fisher Scoring iterations: 1
## 
## 
##               Theta:  0.447 
##           Std. Err.:  0.107 
## 
##  2 x log-likelihood:  -325.438
library(lmtest)
lrtest(modele_incid,modele_nb)
## Likelihood ratio test
## 
## Model 1: reactors ~ type + offset(log_par)
## Model 2: reactors ~ type + offset(log_par)
##   #Df  LogLik Df  Chisq Pr(>Chisq)    
## 1   4 -259.74                         
## 2   5 -162.72  1 194.04  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Réponse: Le test de rapport de vraisemblance indique que le modèle Binomial négatif est statistiquement meilleur que le modèle de Poisson (P <0.001).

3.9. Comparez graphiquement le compte d’animaux positifs à la tuberculose prédits par ce dernier modèle et les comptes réel d’animaux positifs. Que notez-vous?

#En premier, je réunis les valeurs observées et prédites dans un jeu de données.
obs_pred <- data.frame(cbind(obs=modele_nb$y, pred=modele_nb$fitted.values))

#Ensuite je genère les deux polygones de fréquence dans une même figure.
library(ggplot2)
ggplot(data=obs_pred, mapping=aes(x=obs)) +
  geom_freqpoly(color="blue")+ #Je demande d'abbord une ligne pour les valeurs observées
  guides(color=FALSE) + #Je demande à ne pas avoir de légende dans ce cas
  geom_freqpoly(mapping=aes(x=pred, color="blue"))+ #Je demande ensuite une ligne pour les valeurs prédites
  xlim(0, NA)+ #J'enlève les valeurs sous zéro
  theme_bw() #Un thème blanc
**Figure.** Comparaison des comptes d'animaux réactifs observés (bleu) et prédits (rouge).

Figure. Comparaison des comptes d’animaux réactifs observés (bleu) et prédits (rouge).

Réponse: On note que le modèle prédit moins de troupeaux avec près de 0 animaux positifs (environ 60% des troupeaux) que la réalité (environ 87%). Par contre, le modèle est capable de prédire des comptes assez élevés (jusqu’à 25 animaux réactifs).

8.6 Travaux pratiques 7 - Modèles modifiés en zéro et calcul d’un risque relatif

8.6.1 Exercices

Pour les questions 1 à 3 du TP utilisez le fichier fec.csv (voir description VER p.811).

Dans cette étude nous sommes intéressés à décrire les facteurs de risque associés au compte d’oeufs de parasites dans les fèces de bovins laitier. La variable fec représente le nombre d’oeufs/5g de fèces qui pourra être prédit en fonction de différents prédicteurs. Dans cet exemple il n’y a pas de dénominateur à considérer (i.e. une variable offset n’est pas nécessaire; chaque animal a été échantillonné une seule fois).

  1. D’abord représenter graphiquement la variable fec. S’agit-il d’une distribution typique pour une donnée de compte? Quelle proportion des observations avait un compte de zéro oeuf?

  2. Essayez d’abord de modéliser l’effet de tx (un traitement à l’Eprinomectin au vêlage) sur le compte d’oeuf (fec) en prenant en compte les facteurs confondants lact, man_heif et man_lact à l’aide d’une régression binomiale négative.

2.1. D’abord, est-ce que le paramètre de dispersion (i.e. le α) est statistiquement différent de zéro? Qu’est-ce que cela vous indique?

2.2. Est-ce que le modèle est adéquat pour vos données?

2.3. Vérifiez si un modèle zéros-enflé Binomial négatif (ZINB) serait préférable à un modèle Binomial négatif.

2.4. À l’aide de ce dernier modèle, expliquez l’effet du traitement à l’Eprinomectin sur le compte d’oeufs de parasite.

Pour la question 3 du TP utilisez le fichier daisy2.csv (voir description VER p.809).

Ne sélectionnez que les 7 troupeaux avec H7=1 et n’utilisez que la 1ère lactation de chaque vache (study_lact=1).

  1. Dans cette étude on se demande si une rétention placentaire (rp) affecte la probabilité de conception à la première saillie (fs) après avoir contrôler pour l’âge de la vache (parity). Les chercheurs désirent calculer la fraction attribuable dans la population (\(AF_p\)).

\(AF_p = (P(E+)(RR-1))/(P(E+)(RR-1)+1))\)

3.1. Dans ce cas, est-ce que ce serait correct de remplacer le risque relatif dans l’équation précédente par un rapport de cotes estimé à l’aide d’un modèle de régression logistique?

3.2. Quel serait le risque relatif de conception à la 1ère saillie et son IC 95% lorsque rétention placentaire est présent vs. absent et après ajustement pour l’âge de la vache?

3.3. Quel serait la fraction attribuable (\(AF_p\)) dans la population due aux rétentions placentaires? Comment interprétez-vous ce résultat?

3.4. Question bonus (i.e. vous aurez 2 banana-points supplémentaires si vous répondez correctement): Comment pourriez-vous obtenir un IC 95% pour l’\(AF_p\)?

8.6.2 Code R et réponses

Pour les questions 1 à 3 du TP utilisez le fichier fec.csv (voir description VER p.811).

#J'importe la base de données
fec <-read.csv(file="fec.csv", header=TRUE, sep=";")

#Je recode certaines variables
fec$fec<-as.numeric(fec$fec)
fec$lact<-as.factor(fec$lact)
fec$past_lact<-as.factor(fec$past_lact)
fec$man_heif<-as.factor(fec$man_heif)
fec$man_lact<-as.factor(fec$man_lact)

#Visualisons la base de données
head(fec)
##   province herd cow visit tx fec lact season past_lact man_heif man_lact
## 1        1    1  46     5  0   3    1      2         1        0        0
## 2        1    1  46     6  0   3    1      2         1        0        0
## 3        1    1  46     7  0  11    1      2         1        0        0
## 4        1    1  46     8  0   7    1      3         1        0        0
## 5        1    1  46     9  0  17    1      3         1        0        0
## 6        1    1  46    10  0   6    1      3         1        0        0

Dans cette étude nous sommes intéressés à décrire les facteurs de risque associés au compte d’oeufs de parasites dans les fèces de bovins laitier. La variable fec représente le nombre d’oeufs/5g de fèces qui pourra être prédit en fonction de différents prédicteurs. Dans cet exemple il n’y a pas de dénominateur à considérer (i.e. une variable offset n’est pas nécessaire; chaque animal a été échantillonné une seule fois).

  1. D’abord représenter graphiquement la variable fec. S’agit-il d’une distribution typique pour une donnée de compte? Quelle proportion des observations avait un compte de zéro oeuf?
#Distribution de notre variable dépendante (fec)
library(ggplot2)
ggplot(fec, aes(x=fec)) +
  geom_histogram(colour="black", fill="grey")+
  theme_bw() +
  xlab("Nombre d'oeufs/5g de fèces")+
  ylab("Nombre de vache")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Réponse: La distribution du compte d’oeufs est « skewed » comme le sont souvent les données de compte et d’incidence. 50% des observations ont un compte de zéro oeuf.

  1. Essayez d’abord de modéliser l’effet de tx (un traitement à l’Eprinomectin au vêlage) sur le compte d’oeuf (fec) en prenant en compte les facteurs confondants lact, man_heif et man_lact à l’aide d’une régression binomiale négative.
# Le modèle BN  
library(MASS)
modele_nb <- glm.nb(fec ~ tx + lact + man_heif + man_lact, data=fec)
summary(modele_nb)
## 
## Call:
## glm.nb(formula = fec ~ tx + lact + man_heif + man_lact, data = fec, 
##     init.theta = 0.2034616714, link = log)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5454  -1.1257  -0.8016  -0.1563   5.0501  
## 
## Coefficients:
##             Estimate Std. Error z value       Pr(>|z|)    
## (Intercept)  2.58438    0.08977  28.789        < 2e-16 ***
## tx          -0.85893    0.13467  -6.378 0.000000000179 ***
## lact1       -1.10775    0.10696 -10.356        < 2e-16 ***
## man_heif1   -1.26782    0.13150  -9.641        < 2e-16 ***
## man_lact1    1.68948    0.13427  12.583        < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for Negative Binomial(0.2035) family taken to be 1)
## 
##     Null deviance: 2361.7  on 2249  degrees of freedom
## Residual deviance: 2020.3  on 2245  degrees of freedom
## AIC: 10560
## 
## Number of Fisher Scoring iterations: 1
## 
## 
##               Theta:  0.20346 
##           Std. Err.:  0.00755 
## 
##  2 x log-likelihood:  -10548.11100

2.1. D’abord, est-ce que le paramètre de dispersion (i.e. le Theta) est statistiquement différent de zéro? Qu’est-ce que cela vous indique?

# Un modèle Poisson
modele_p <- glm(fec ~ tx + lact + man_heif + man_lact, family="poisson", data=fec)

#Test de rapport de vraisemblance
library(lmtest)
lrtest(modele_p, modele_nb)
## Likelihood ratio test
## 
## Model 1: fec ~ tx + lact + man_heif + man_lact
## Model 2: fec ~ tx + lact + man_heif + man_lact
##   #Df   LogLik Df Chisq Pr(>Chisq)    
## 1   5 -30918.0                        
## 2   6  -5274.1  1 51288  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Réponse: Oui le paramètre de dispersion est statistiquement différent de zéro puisque son IC 95% (0.203 +/- 1.96*0.008) n’inclus pas la valeur zéro. Un test de rapport de vraisemblance comparant des modèles Poisson et Binomial négatif arrive au même conclusions (P < 0.001). Cela indique que le modèle de régression Binomial négatif est préférable au modèle de Poisson (i.e. la variance n’égale pas la moyenne pour au moins un profil de prédicteurs).

2.2. Est-ce que le modèle est adéquat pour vos données?

library(DHARMa)
#Permet de générer des résiduels par simulation
negbin_simulation <- simulateResiduals(fittedModel = modele_nb)

#Permet de visualiser les résiduels vs les valeurs prédites.
plotSimulatedResiduals(simulationOutput = negbin_simulation)
## plotSimulatedResiduals is deprecated, please switch your code to simply using the plot() function
## DHARMa:testOutliers with type = binomial may have inflated Type I error rates for integer-valued distributions. To get a more exact result, it is recommended to re-run testOutliers with type = 'bootstrap'. See ?testOutliers for details

#Permet de tester avec le Pearson chi-square test s'il y a surdispersion 
testDispersion(negbin_simulation, type="PearsonChisq")
## Note that the chi2 test on Pearson residuals is biased for mixed models towards underdispersion. Tests with alternative = two.sided or less are therefore not reliable. I recommend to test only with alternative = 'greater', i.e. test for overdispersion
## 
##  Parametric dispersion test via mean Pearson-chisq statistic
## 
## data:  negbin_simulation
## dispersion = 2.21, df = 2245, p-value < 2.2e-16
## alternative hypothesis: two.sided

Réponse: Le test de \(chi^2\) de Pearson indique que le modèle n’est pas adéquat pour les données (P < 0.05). Donc le modèle ne semble pas adéquat. Sur la figure, il semble y avoir 6 profils de prédicteurs problématiques (sur 12 profils potentiels).

2.3. Vérifiez si un modèle zéros-enflé Binomial négatif (ZINB) serait préférable à un modèle Binomial négatif.

library(pscl)
modele_zinb<-zeroinfl(fec ~ tx + lact + man_heif + man_lact, dist="negbin", data=fec)
vuong(modele_nb, modele_zinb)
## Vuong Non-Nested Hypothesis Test-Statistic: 
## (test-statistic is asymptotically distributed N(0,1) under the
##  null that the models are indistinguishible)
## -------------------------------------------------------------
##               Vuong z-statistic             H_A   p-value
## Raw                   -2.524802 model2 > model1 0.0057882
## AIC-corrected         -1.698782 model2 > model1 0.0446801
## BIC-corrected          0.663091 model1 > model2 0.2536362

Réponse: En appliquant le test de Vuong, on note que 2 des 3 tests statistiques réalisés supportent que le modèle ZINB est supérieur au NB.

2.4. À l’aide de ce dernier modèle, expliquez l’effet du traitement à l’Eprinomectin sur le compte d’oeufs de parasite.

#Ayayaye! ;-)

# LA PARTIE LOGISTIQUE
# Extraire les coefficients et les erreurs types de la partie logistique (binomiale) du modèle dans une même table
coefs_logi <- as.data.frame(summary(modele_zinb)$coefficients$zero[,1:2])
names(coefs_logi)[2] = "SE"
# Calculer les IC95
coefs_logi$lower.ci <- coefs_logi$Estimate-1.96*coefs_logi$SE
coefs_logi$upper.ci <- coefs_logi$Estimate+1.96*coefs_logi$SE
#Ici ont pourrait déjà renverser tout les coefficients et les CI

# Mettre à l'exposant les coefficients
OR <- exp(coefs_logi)
# Retirer l'intercept (la 1ère rangée) et les erreurs-types
OR <- OR[-c(1), ]
OR <- subset(OR, select = -c(SE))


# LA PARTIE COMPTE
# Extraire les coefficients et les erreurs types de la partie Binomiale négative du modèle dans une même table
coefs <- as.data.frame(summary(modele_zinb)$coefficients$count[,1:2])
names(coefs)[2] = "SE"
# Calculer les IC95
coefs$lower.ci <- coefs$Estimate-1.96*coefs$SE
coefs$upper.ci <- coefs$Estimate+1.96*coefs$SE
# Mettre à l'exposant les coefficients
IR <- exp(coefs)
# Retirer l'intercept (la 1ère rangée), le paramètre de dispersion (la 6ième rangée) et les erreurs-types
IR <- IR[-c(1, 5), ]
IR <- subset(IR, select=-c(SE))


#Finalement, on pourra demander à voir ces tables
library(knitr)
kable(round(OR, digits=2), caption="**Table.** Partie logistique du modèle zéro-enflé Binomial négatif (ZINB).")%>%
  kable_styling()
Table. Partie logistique du modèle zéro-enflé Binomial négatif (ZINB).
Estimate lower.ci upper.ci
tx 1.24 0.60 2.590000e+00
lact1 1.93 0.99 3.790000e+00
man_heif1 1.36 0.58 3.200000e+00
man_lact1 0.00 0.00 2.116468e+153 
kable(round(IR, digits=2), caption="**Table.** Partie binomiale négative du modèle zéro-enflé Binomial négatif (ZINB).")%>%
  kable_styling()
Table. Partie binomiale négative du modèle zéro-enflé Binomial négatif (ZINB).
Estimate lower.ci upper.ci
tx 0.44 0.33 0.58
lact1 0.38 0.31 0.47
man_heif1 0.29 0.22 0.38
Log(theta) 0.26 0.23 0.29

Réponse: Les vaches traitées à l’Eprinomectin au vêlage avaient 1.24 (IC 95% : 0.60, 2.59) fois les odds de ne pas avoir d’oeufs de parasites dans leur fèces comparativement aux vaches non traitées et elles avaient 0.44 (IC 95% : 0.33, 0.58) fois le nombre d’oeufs de parasites des vaches non-traitées.

Pour la question 3 du TP utilisez le fichier daisy2.csv (voir description VER p.809).

daisy2 <-read.csv(file="daisy2.csv", header=TRUE, sep=",")

Ne sélectionnez que les 7 troupeaux avec H7=1 et n’utilisez que la 1ère lactation observée sur chaque vache (study_lact=1).

daisy2_mod<-subset(daisy2, h7==1)
daisy2_mod<-subset(daisy2_mod, study_lact==1)
  1. Dans cette étude on se demande si une rétention placentaire (rp) affecte la probabilité de conception à la première saillie (fs) après avoir contrôler pour l’âge de la vache (parity). Les chercheurs désirent calculer la fraction attribuable dans la population (\(AF_p\)).

\(AF_p = (P(E+)(RR-1))/(P(E+)(RR-1)+1))\)

3.1. Dans ce cas, est-ce que ce serait correct de remplacer le risque relatif dans l’équation précédente par un rapport de cotes estimé à l’aide d’un modèle de régression logistique?

library(summarytools)
print(dfSummary(daisy2_mod$fs), method='render')
## daisy2_mod$fs was converted to a data frame

Data Frame Summary

daisy2_mod

Dimensions: 1795 x 1
Duplicates: 1792
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 fs [integer] Min : 0 Mean : 0.5 Max : 1
0:714(49.9%)
1:718(50.1%)
 1432 (79.8%) 363 (20.2%)

Generated by summarytools 0.9.8 (R version 4.0.4)
2022-02-11

Réponse: 50% des observations ont fs=1. Il ne s’agit donc pas d’un événement rare (i.e. < 5%). Ce ne serait pas approprié d’utiliser une supposition qui n’est valide que si la maladie est rare.

3.2. Quel serait le risque relatif de conception à la 1ère saillie et son IC 95% lorsque rétention placentaire est présent vs. absent et après ajustement pour l’âge de la vache?

modele_poisson <- glm(fs ~ rp + parity, family="poisson", data=daisy2_mod)

#Je demande la variance robuste
library(sandwich)
rob_SE <-sqrt(diag(sandwich(modele_poisson)))

#Pour faciliter la lecture, je pourrais ajouter ces erreur-types robustes à mes coefficients dans une table
tab_SE <- data.frame(cbind(Estimate=modele_poisson$coefficients, robust_SE=rob_SE))

#Puis calculer les IC95
tab_SE$lower.ci <- tab_SE$Estimate-1.96*tab_SE$robust_SE
tab_SE$upper.ci <- tab_SE$Estimate+1.96*tab_SE$robust_SE

#Enlever l'intercept, les SE et mettre tout à l'exposant pour avoir des RR 
tab_SE <- tab_SE[-c(1), ]
tab_SE <- exp(subset(tab_SE, select=-c(robust_SE)))

library(knitr)
kable(round(tab_SE, digits=2), caption="**Table.** Modèle de Poisson avec erreur-types robustes pour estimer le risque relatif de conception à la 1ère saillie.")%>%
  kable_styling()
Table. Modèle de Poisson avec erreur-types robustes pour estimer le risque relatif de conception à la 1ère saillie.
Estimate lower.ci upper.ci
rp 0.91 0.75 1.09
parity 0.95 0.92 0.99

Réponse: Le risque de conception à la première saillie pour une vache qui a eu une rétention placentaire était 0.91 fois (IC 95% : 0.75, 1.09) celui d’une vache qui n’a pas eu de rétention placentaire. Ce n’est pas statistiquement significatif cependant.

3.3. Quel serait la fraction attribuable (\(AF_p\)) dans la population due aux rétentions placentaires? Comment interprétez-vous ce résultat?

#Vérifier prévalence de l'exposition (rp)
library(summarytools)
print(dfSummary(daisy2_mod$rp), method='render')
## daisy2_mod$rp was converted to a data frame

Data Frame Summary

daisy2_mod

Dimensions: 1795 x 1
Duplicates: 1793
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 rp [integer] Min : 0 Mean : 0.1 Max : 1
0:1613(89.9%)
1:182(10.1%)
 1795 (100.0%) 0 (0.0%)

Generated by summarytools 0.9.8 (R version 4.0.4)
2022-02-11

#Calculer l'AFp
afp <- 0.101*(0.91-1)/(0.101*(0.91-1)+1)
afp
## [1] -0.009173386

Réponse: En supposant que la relation est causale, une réduction de 1% (i.e., -0.009) de la conception à la 1ère saillie serait dûe aux rétentions placentaires.

3.4. Question bonus (i.e. vous aurez 2 banana-points supplémentaires si vous répondez correctement): Comment pourriez-vous obtenir un IC 95% pour l’\(AF_p\)?

Réponse: À l’aide du Bootstrap, on pourrait recréer un grand nombre de jeu de données et estimer le risque relatif et la prévalence de rétention placentaire dans chaque jeu de données. Ensuite on calcule l’\(AF_p\) de chaque jeu de données et on rapporte le percentile 2.5 et 97.5 de l’\(AF_p\) comme IC 95%.

9 Analyses de survie

9.1 Généralités

L’analyse de survie est une collection de procédures statistiques pour l’analyse de données où la variable dépendante est le temps jusqu’à ce qu’un certain événement survienne. Cet événement peut être un décès, un événement de santé, une rechute après une rémission, une guérison ou toute autre expérience vécue par le sujet. Le temps peut être des années, mois, semaines ou jours depuis le début du suivi jusqu’à ce que l’événement survienne. Ce temps peut référer à l’âge du sujet au moment de l’événement, à un moment de son cycle de production (e.g. jours en lait), etc. On considère en général que l’événement ne se produit qu’une seule fois. Une caractéristique de ces données est que souvent plusieurs observations sont « censurées » (i.e. plusieurs individus n’expérimentent pas l’événement et on ne peut donc avoir un temps précis jusqu’à l’événement pour ces individus). La variable dépendante est le temps de survie sans l’événement. L’événement est l’échec (failure) parce que c’est souvent un événement « négatif ». Mais il peut aussi être positif, comme le temps pour le retour à la compétition après une chirurgie pour un cheval de course.

La librairie survival vous permettra de réaliser la plupart de vos analyses de survie.La librairie survminer facilitera la présentation des figures typiquement utilisées en analyse de survie.

Certains cas particuliers qui ne seront pas vu dans le cadre du cours demanderont des analyses de survie particulières :
1) si plus d’un événement sont considérés (e.g. une maladie qui se produit plus d’une fois, comme des cas de mammites), on considère alors que c’est un événement récurrent;
2) si le décès peut être le résultat de différentes causes, on peut considérer que c’est un risque compétitif (i.e. les maladies compétitionnent entre elles pour causer le décès).

Le jeu de donnée calf_pneu.csv sera utilisé pour les analyses non-paramétriques.

#J'importe ce jeu de données
calf <-read.csv(file="calf_pneu.csv", header=TRUE, sep=";")
head(calf)
##   calf stock days pn
## 1    1     1   27  1
## 2    2     1   49  1
## 3    3     1   72  1
## 4    4     1   79  1
## 5    5     1   90  1
## 6    6     1  113  1

9.2 Format des données pour une analyse de survie

La table plus haut illustre la disposition des données pour leur analyse, telle que requise par votre logiciel statistique. Une variable (calf dans ce cas) doit identifier chaque sujet, une autre (days) donne le temps de survie (votre variable déprendante), une autre indique le statut de l’individu à la fin du suivi (pn; en général 0 si censure, 1 si l’événement s’est produit). Les autres variables (une seule, stock, dans ce cas) seront les variables prédictives.

Par convention, les noms de variables dur et statut sont souvent utilisés pour définir le temps de survie et le statut de l’individu à la fin du suivi, respectivement.

9.3 Analyses non-paramétriques (Kaplan-Meier)

9.3.1 Table de Kaplan-Meier et temps median de survie

La fonction Surv() de la librairie survival permet d’indiquer les temps de survie et les statuts. C’est cette combinaison qui sera utilisée comme variable réponse dans les étapes subséquentes. Le premier argument indiqué est la variable décrivant le temps de survie (days), le deuxième argument est la variable décrivant le statut (pn).

La table de survie de Kaplan-Meier peut ensuite être produite à l’aide de la fonction survfit(). Le premier argument indique la fonction qui servira à générer les tables et courbes de survie. Si aucun prédicteur n’est indiqué (i.e., ~ 1), on demande alors une seule table et une seule courbe de survie. En ajoutant un prédicteur après le ~, on aura alors une table et une courbe par niveau du prédicteur.

  • Vous pourrez directement utiliser la fonction survfit() dans ce cas, le temps median de survie et son IC95 vous sera rapporté.
  • Vous pouvez aussi créer un nouvel objet (par exemple km_fit <- survfit()) et utiliser la fonction summary() sur cet objet. Dans ce cas, la table de survie de Kaplan-Meier sera présentée.

Le code suivant, par exemple, permet de présenter le temps médian de survie, puis de générer un nouvel objet que j’ai nommé km_fit et qui est, en fait, la table de Kaplan-Meier décrivant le temps jusqu’à une pneumonie pour 24 veaux.

library(survival)
survfit(Surv(days, pn) ~ 1, data=calf)
## Call: survfit(formula = Surv(days, pn) ~ 1, data = calf)
## 
##       n  events  median 0.95LCL 0.95UCL 
##      24      12     123     113      NA
km_fit <- survfit(Surv(days, pn) ~ 1, data=calf)
summary(km_fit)
## Call: survfit(formula = Surv(days, pn) ~ 1, data = calf)
## 
##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
##    27     24       1    0.958  0.0408        0.882        1.000
##    49     23       1    0.917  0.0564        0.813        1.000
##    72     22       1    0.875  0.0675        0.752        1.000
##    79     21       2    0.792  0.0829        0.645        0.972
##    89     19       1    0.750  0.0884        0.595        0.945
##    90     18       1    0.708  0.0928        0.548        0.916
##   101     17       1    0.667  0.0962        0.502        0.885
##   113     15       2    0.578  0.1019        0.409        0.816
##   117      9       1    0.514  0.1089        0.339        0.778
##   123      6       1    0.428  0.1198        0.247        0.741

9.3.2 Courbe de survie de Kaplan-Meier

La courbe de survie de Kaplan-Meier pourra être générée en appliquant la fonction ggsurvplot() de la librairie survminerà ce nouvel objet km_fit. La librairie survminer et sa fonction ggsurvplot() sont très flexibles pour produire les figures en lien avec les analyses de survie.

library(survminer)
survie <- ggsurvplot(km_fit, conf.int = TRUE)
survie

Et ce sera ensuite facile de modifier cette figure avec toutes les fonctions de ggplot auxquelles vous êtes habitué. Par exemple:

survie$plot +theme_bw()

En continuant avec survminer, je pourrais demander la fonction d’échec (i.e., le contraire de la fonction de survie) à l’aide de l’argument fun="event".

library(survminer)
echec <- ggsurvplot(km_fit, conf.int = TRUE, fun="event")
echec

Ou encore la fonction de hasard cummulatif (i.e., cummulative hazard function) à l’aide de la fonction fun="cumhaz".

library(survminer)
cum <- ggsurvplot(km_fit, conf.int = TRUE, fun="cumhaz")
cum

9.3.3 Estimer la probabilité de survie pour un temps donnée

L’argument times= de la fonction survfit() permet d’estimer la proportion (et son IC95) des individus qui “survivront” jusqu’à un temps t. Par exemple, ce code me permet d’estimer que 91.7% (IC95= 81.3, 100) des veaux n’avaient pas eu de pneumonie après 50 jours.

library(survival)
summary(survfit(Surv(days, pn) ~ 1, data=calf), times = 50)
## Call: survfit(formula = Surv(days, pn) ~ 1, data = calf)
## 
##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
##    50     22       2    0.917  0.0564        0.813            1

9.3.4 Comparaisons entre niveaux d’un prédicteur catégorique

L’analyse de survie non-paramétrique (i.e. Kaplan-Meier) permet de comparer les fonctions de survie des différents niveaux d’un prédicteur catégorique. Le code suivant, par exemple, permet de vérifier l’effet du type d’élevage (variable stock; en batch vs. en continu) sur le temps jusqu’à la pneumonie. Vous aurez maintenant un temps median de survie par niveau d’exposition (notez que celui-ci ne peut pas toujours être calculé, dépendamment du nombre d’observations).

library(survival)
survfit(Surv(days, pn) ~ stock, data=calf)
## Call: survfit(formula = Surv(days, pn) ~ stock, data = calf)
## 
##          n events median 0.95LCL 0.95UCL
## stock=0 12      4     NA     123      NA
## stock=1 12      8    113      79      NA

Vous aurez également une table de Kaplan-Meier par niveau d’exposition.

library(survival)
km_fit_stock <- survfit(Surv(days, pn) ~ stock, data=calf)
summary(km_fit_stock)
## Call: survfit(formula = Surv(days, pn) ~ stock, data = calf)
## 
##                 stock=0 
##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
##    79     12       1    0.917  0.0798        0.773            1
##    89     11       1    0.833  0.1076        0.647            1
##   101     10       1    0.750  0.1250        0.541            1
##   123      5       1    0.600  0.1673        0.347            1
## 
##                 stock=1 
##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
##    27     12       1    0.917  0.0798        0.773        1.000
##    49     11       1    0.833  0.1076        0.647        1.000
##    72     10       1    0.750  0.1250        0.541        1.000
##    79      9       1    0.667  0.1361        0.447        0.995
##    90      8       1    0.583  0.1423        0.362        0.941
##   113      7       2    0.417  0.1423        0.213        0.814
##   117      4       1    0.312  0.1398        0.130        0.751

Finalement, vous aurez aussi une courbe de survie par niveau d’exposition.

library(survminer)
survie <- ggsurvplot(km_fit_stock, conf.int = TRUE)

survie$plot + theme_bw() +
  xlab("Nombre de jours") +
  ylab("Probabilité de survie")+ 
  scale_fill_discrete(name = "Type d'élevage", labels = c("En batch", "En continu"))+
  scale_color_discrete(name = "Type d'élevage", labels = c("En batch", "En continu"))

Finalement, vous pourrez tester les différences entre les niveaux d’exposition à l’aide des tests de log-rank et/ou de Wilcoxon à l’aide de la fonction survdiff(). Le premier argument est notre modèle, le deuxième est le jeu de données, l’argument rho=0 permettra d’indiquer que le test de log-rank est désiré. En utilisant rho=1, ce sera plutôt le test de Wilcoxon qui sera réalisé.

library(survival)
#log-rank
survdiff(Surv(days, pn) ~ stock, data=calf, rho=0)
## Call:
## survdiff(formula = Surv(days, pn) ~ stock, data = calf, rho = 0)
## 
##          N Observed Expected (O-E)^2/E (O-E)^2/V
## stock=0 12        4     6.89      1.21      2.99
## stock=1 12        8     5.11      1.63      2.99
## 
##  Chisq= 3  on 1 degrees of freedom, p= 0.08
#Wilcoxon
survdiff(Surv(days, pn) ~ stock, data=calf, rho=1)
## Call:
## survdiff(formula = Surv(days, pn) ~ stock, data = calf, rho = 1)
## 
##          N Observed Expected (O-E)^2/E (O-E)^2/V
## stock=0 12     2.89     5.25      1.06      3.13
## stock=1 12     6.41     4.05      1.38      3.13
## 
##  Chisq= 3.1  on 1 degrees of freedom, p= 0.08

Dans ce cas, les deux tests donnent une valeur de P de 0.08. C’est donc dire que les courbes de survie des veaux élevés en batch ou en continu ne sont pas différentes.

Notez que plus d’une variable peut être utilisée pour stratifier les données. Par exemple, le jeu de données pgtrial.csv contient plusieurs prédicteurs. Cette étude est un essai clinique randomisé sur l’effet de l’administration d’une dose de prostaglandine vs. d’un placebo (la variable tx) au début de la période de reproduction sur le nombre de jours (la variable dar) jusqu’à la conception (la variable preg). L’hypothèse était que l’administration de prostaglandine réduirait le nombre de jours jusqu’à la conception. Les 319 vaches de cette étude étaient suivies jusqu’à un maximum de 346 jours en lait. Trois autres prédicteurs étaient aussi évalués: le nombre de lactation (lact; 1, 2, 3…), l’état de chair (thin; 0=normal, 1=thin) et le troupeau (herd; 3 troupeaux).

pgtrial <-read.csv(file="pgtrial.csv", header=TRUE, sep=";")
head(pgtrial)
##   herd cow tx lact thin dar preg
## 1    1   1  0    1    0   1    1
## 2    1   2  1    4    1   1    1
## 3    1   3  1    1    0   2    1
## 4    1   4  1    1    0   3    1
## 5    1   5  1    6    0   3    0
## 6    1   6  1    1    0   3    1
#J'indique les variables catégoriques dans mon jeu de données
pgtrial$thin <- factor(pgtrial$thin) 
pgtrial$herd <- factor(pgtrial$herd)

Le code suivant pourra être utilisé pour effectuer une analyse de survie non-paramétrique par groupe de traitement (tx) ET par état de chair (thin). Dans ce cas, vous auriez quatre strates de tx par thin possibles (0-0, 0-1, 1-0, et 1-1). La fonction survfit() vous rapportera alors toutes les comparaisons entre chaque paire de strates (4 comparaisons dans ce cas).

library(survival)

km_fit_pg <- survfit(Surv(dar, preg) ~ tx + thin, data=pgtrial)
survdiff(Surv(dar, preg) ~ tx + thin, data=pgtrial, rho=0)
## Call:
## survdiff(formula = Surv(dar, preg) ~ tx + thin, data = pgtrial, 
##     rho = 0)
## 
##               N Observed Expected (O-E)^2/E (O-E)^2/V
## tx=0, thin=0 73       63     60.8    0.0806     0.107
## tx=0, thin=1 95       76     88.3    1.7023     2.634
## tx=1, thin=0 73       60     53.8    0.7213     0.928
## tx=1, thin=1 78       65     61.2    0.2380     0.317
## 
##  Chisq= 2.8  on 3 degrees of freedom, p= 0.4
library(survminer)
ggsurvplot(km_fit_pg, conf.int = TRUE)

C’est beaucoup d’information sur une même figure! Vous pourriez aussi la séparer à l’aide de la fonction facet_grid() de la librairie ggplot2 afin de pouvoir comparer plus aisément l’effet du traitement chez les vaches maigres, puis chez les vaches normales.

ggsurv <- ggsurvplot(km_fit_pg, conf.int = TRUE)
   
ggsurv$plot +theme_bw() + 
  theme (legend.position = "right")+
  facet_grid( ~ thin)

9.4 Régression de Cox à hasard proportionnel

Si on veut comparer la survie de deux groupes en ajustant pour les effets confondants ou des modificateurs d’effet potentiels, on peut utiliser un modèle de risques proportionnels (proportional hazards model) ou modèle de régression de Cox. La fonction coxph() (pour Cox Proportional Hazard) de la librairie survival permet de réaliser les régressions de Cox.

Par exemple, le code suivant permet d’estimer un modèle de Cox à hasard proportionnel qui décrit l’effet d’un traitement à la prostaglandine (tx) sur le temps jusqu’à la conception (dar et preg) après ajustement pour les biais de confusion par la parité (lact), l’état de chair (thin) et le troupeau d’origine (herd).

library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~ tx + lact + thin + herd, data=pgtrial)
summary(PH_fit_pg)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx + lact + thin + herd, data = pgtrial)
## 
##   n= 319, number of events= 264 
## 
##           coef exp(coef) se(coef)      z Pr(>|z|)  
## tx     0.19603   1.21657  0.12543  1.563    0.118  
## lact  -0.04360   0.95733  0.04118 -1.059    0.290  
## thin1 -0.14713   0.86318  0.13804 -1.066    0.286  
## herd2 -0.28544   0.75169  0.16993 -1.680    0.093 .
## herd3  0.04032   1.04115  0.17453  0.231    0.817  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##       exp(coef) exp(-coef) lower .95 upper .95
## tx       1.2166     0.8220    0.9514     1.556
## lact     0.9573     1.0446    0.8831     1.038
## thin1    0.8632     1.1585    0.6586     1.131
## herd2    0.7517     1.3303    0.5388     1.049
## herd3    1.0411     0.9605    0.7395     1.466
## 
## Concordance= 0.565  (se = 0.019 )
## Likelihood ratio test= 9.94  on 5 df,   p=0.08
## Wald test            = 9.76  on 5 df,   p=0.08
## Score (logrank) test = 9.78  on 5 df,   p=0.08

La fonction summary() vous permet de rapporter le nombre d’observations (n=319) et le nombre de vaches ayant eu une conception (n=264). Ont vous rapporte ensuite les coefficients pour chacun des prédicteurs, leur erreur-type, leur IC95 et la valeur de P du test de Wald pour ce coefficient particulier. La table suivante présente les hazard ratios (HR) et leur IC95 (ce sont simplement les coefficients et leur IC95 mis à l’exposant). Enfin, le test de rapport de vraisemblance qui vérifie si au moins un coefficient est différent de 0 est présenté (ici, P=0.08).

Pour générer une figure de la fonction de survie de Cox, on devra utiliser la fonction ggadjustedcurves() de la librairie survminer. L’argument variable="tx" me permet de générer des fonctions de survie de Cox par niveaux d’un prédicteur (ici tx).

#La courbe de survie de Cox
library(survminer)
ggadjustedcurves(PH_fit_pg, variable="tx")
**Figure.** Fonction de survie de Cox par niveau de la variable traitement.

Figure. Fonction de survie de Cox par niveau de la variable traitement.

9.4.1 Analyses stratifiées

On peut réaliser une analyse stratifiée par un prédicteur à l’aide de la fonction strata(). L’analyse stratifiée par un prédicteur pourra être utile:
- lorsque ce prédicteur ne satisfait pas à la supposition de proportionnalité des Hazard Ratio et que le prédicteur n’est pas d’intérêt direct (e.g. un facteur confondant);
- afin de prendre en compte le regroupement d’observations (la variable de stratification sera alors la variable indiquant le groupe d’appartenance; herd dans l’exemple suivant).

library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~ tx + lact + thin + strata(herd), data=pgtrial)
summary(PH_fit_pg)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx + lact + thin + strata(herd), 
##     data = pgtrial)
## 
##   n= 319, number of events= 264 
## 
##           coef exp(coef) se(coef)      z Pr(>|z|)
## tx     0.20490   1.22740  0.12622  1.623    0.105
## lact  -0.04218   0.95870  0.04101 -1.029    0.304
## thin1 -0.13871   0.87048  0.13857 -1.001    0.317
## 
##       exp(coef) exp(-coef) lower .95 upper .95
## tx       1.2274     0.8147    0.9584     1.572
## lact     0.9587     1.0431    0.8847     1.039
## thin1    0.8705     1.1488    0.6634     1.142
## 
## Concordance= 0.558  (se = 0.021 )
## Likelihood ratio test= 5.43  on 3 df,   p=0.1
## Wald test            = 5.44  on 3 df,   p=0.1
## Score (logrank) test = 5.46  on 3 df,   p=0.1

Notez que l’effet de la variable utilisée pour stratifier n’est plus calculé maintenant.

9.4.2 Prédicteur dont la valeur change dans le temps

Lorsqu’un prédicteur peut changer de valeur en cours de suivi, le jeu de données doit être réorganisé avec plusieurs intervalles pour chaque sujet. Ce format s’appelle le counting process format (CP). Le format CP est en fait adapté à plusieurs situations d’analyse de survie complexes:
- quand il y a présence de prédicteurs dont la valeur change dans le temps;
- quand l’âge plutôt que le temps est utilisé comme mesure du suivi (on voudra alors indiquer l’âge de début et l’âge de fin);
- quand il y a des évènements récurrents et/ou que l’occurrence de l’évènement ne peut être observé en continu (ex: animaux testés mensuellement pour identifier l’acquisition d’une infection).

Le format général des données dans le format CP est montré à la table suivante. Pour chaque individu, il y a plusieurs lignes: chaque temps de suivi est divisé en petits intervalles de temps. Il y a aussi deux variables de temps spécifiées pour chaque individu, une indiquant le début du suivi (start dans ce cas) et une indiquant la fin du suivi (stop dans ce cas). Une variable (dead2 dans ce cas) indique ce qui s’est produit à la fin du suivi (dans cet exemple censure=0 et mort=1).

stan <-read.csv(file="stanlong.csv", header=TRUE, sep=";")
head(stan)
##   id dead surg ageaccpt trans plant start dead2 stop
## 1  1    1    0 30.84463     0     0   0.0     1 49.0
## 2  2    1    0 51.83573     0     0   0.0     1  5.0
## 3  3    1    0 54.29706     1     0   0.0     0  0.1
## 4  3    1    0 54.29706     1     1   0.1     1 15.0
## 5  4    1    0 40.26283     1     0   0.0     0 35.0
## 6  4    1    0 40.26283     1     1  35.0     1 38.0

Dans l’exemple plus haut, on voit que les individus 3 et 4 ont bien 2 intervalles de temps (2 rangées) puisque le prédicteur trans (indiquant s’ils ont eu ou non une transplatation cardiaque) à changé de valeur (de 0 à 1) pour ces individus durant l’étude. Ont comprend donc que l’individu 3 a reçu une transplantation très rapidement à 0.1 jour (c’est là que sons statut trans à changé) et il est malheureusement décédé à 15 jours. L’individu 4 a reçu une transplantation 35 jours après son accident cardio-vasculaire et il est décédé 3 jours plus tard, soit 38 jours après son accident cardio-vasculaire.

Pour analyser ce genre de données, vous devrez indiquer les variables indiquant le début et la fin de chaque intervalle dans votre fonction surv() à la place de votre variable représentant le temps (e.g. dur, dar, ou days). Par exemple, le modèle suivant présente le temps d’un accident cardio-vasculaire jusqu’au décès en fonction de si le patient à reçu une transplantation cardiaque (une variable qui peut changer de valeur dans le temps) et après ajustement pour l’âge du patient.

library(survival)
PH_fit_stan <- coxph(Surv(start, stop, dead2) ~ trans + ageaccpt, data=stan)
summary(PH_fit_stan)
## Call:
## coxph(formula = Surv(start, stop, dead2) ~ trans + ageaccpt, 
##     data = stan)
## 
##   n= 172, number of events= 75 
## 
##              coef exp(coef) se(coef)      z        Pr(>|z|)    
## trans    -1.80047   0.16522  0.27225 -6.613 0.0000000000376 ***
## ageaccpt  0.06020   1.06205  0.01531  3.933 0.0000840052418 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##          exp(coef) exp(-coef) lower .95 upper .95
## trans       0.1652     6.0525    0.0969    0.2817
## ageaccpt    1.0620     0.9416    1.0307    1.0944
## 
## Concordance= 0.721  (se = 0.035 )
## Likelihood ratio test= 44.46  on 2 df,   p=0.0000000002
## Wald test            = 46.04  on 2 df,   p=0.0000000001
## Score (logrank) test = 51.05  on 2 df,   p=0.000000000008

Le HR de décès chez les patients ayant eu une transplantation cardiaque était 0.17 (IC95: 0.10, 0.28) fois celui de ceux qui n’en ont pas eu. Pour cette dernière catégorie, le temps passé sans transplantation par des patients qui seront transplantés dans le futur est aussi compilé.

9.4.3 Prédicteur dont l’effet change dans le temps

Avec le modèle de régression de Cox, le risque peut évoluer au cours du temps, mais il doit rester proportionnel entre sujets avec différents niveaux d’exposition. Cette suposition pourra être vérifiée (voir section évaluation du modèle). Cette supposition peut aussi être relaxée en ajoutant une interaction entre le temps et un prédicteur. Si cette interaction est significativement différente de zéro, on concluera que le risque n’était pas proportionnel et ont présentera alors les résultats du modèle avec l’interaction. Pour ce faire, la variable représentant le temps pourra être transformée (e.g., une transformation log, une catégorisation en deux, ou plus de deux catégories, etc) en fonction de la biologie du phénomène étudié.

Par exemple, le code suivant permettrait d’évaluer une interaction avec le temps représentant un changement d’effet de la prostaglandine entre les 5 premiers jours vs. le reste de la période de suivi. Ont pourrait émettre l’hypothèse que le traitement aux prostaglandines aura un effet dans les 5 jours suivants l’administration, mais aucun ou peu d’effet par la suite. Important: en ajoutant un terme d’interaction (ex: \(tx*time5\) dans votre fonction coxph(), R incluera automatiquement les deux termes principaux pour cette interaction (\(tx\) et \(time5\)) en plus de l’interaction (\(tx*time5\)). Or, il n’est pas possible d’estimer dans ce modèle le terme principal \(time5\) puisque la notion de temps fait également partie de l’issue. Vous devrez donc indiquer à R de retirer ce terme principal simplement en ajoutant - time5 dans votre modèle. De cette manière, ce terme ne sera pas inclu.

#Je commence par créer une prédicteur "temps" que j'ai nommer time et qui prend les valeurs 0-5 days vs. >5 days
pgtrial$time5 <- cut(pgtrial$dar, breaks = c(0, 5, Inf),labels = c("0-5 days", ">5 days"))

#Ensuite, je peux tester une interaction entre time et tx
library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~  tx*time5 -time5 + lact + thin + herd, data=pgtrial)
summary(PH_fit_pg)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx * time5 - time5 + lact + 
##     thin + herd, data = pgtrial)
## 
##   n= 319, number of events= 264 
## 
##                       coef  exp(coef)   se(coef)      z Pr(>|z|)    
## tx                5.461468 235.442858   0.589539  9.264   <2e-16 ***
## lact             -0.055402   0.946105   0.039061 -1.418    0.156    
## thin1            -0.170799   0.842991   0.138408 -1.234    0.217    
## herd2            -0.217645   0.804411   0.170209 -1.279    0.201    
## herd3            -0.037483   0.963211   0.176023 -0.213    0.831    
## tx:time5>5 days  -5.638785   0.003557   0.595293 -9.472   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##                  exp(coef) exp(-coef) lower .95 upper .95
## tx              235.442858   0.004247 74.142836 747.65604
## lact              0.946105   1.056966  0.876376   1.02138
## thin1             0.842991   1.186252  0.642702   1.10570
## herd2             0.804411   1.243146  0.576229   1.12295
## herd3             0.963211   1.038194  0.682166   1.36004
## tx:time5>5 days   0.003557 281.121076  0.001108   0.01142
## 
## Concordance= 0.663  (se = 0.021 )
## Likelihood ratio test= 199.5  on 6 df,   p=<2e-16
## Wald test            = 96.56  on 6 df,   p=<2e-16
## Score (logrank) test = 459.8  on 6 df,   p=<2e-16

Nous notons maintenant que, comme l’hypothèse que nous avions émise, le traitement aux prostaglandine augmente le hasard de conception dans le 5 jours suivant l’injection (HR= 235). Par contre, après 5 jours, l’effet semble minime. Le coefficient après 5 jours serait de -0.18 (i.e., 5.46 + -5.64), donc un HR de 0.84. L’interaction est significative (P< 0.001). Ont pourrait demander des contrastes pour comparer ces derniers résultats.

library(emmeans)
#Je génère d'abord l'objet contrast à partir de mon modèle
contrast <- emmeans(PH_fit_pg, c("tx", "time5")) 

#Je demande les comparaisons pairées, je voulais voir Tx=1 vs Tx=0, j'ai donc du utilisé reverse=TRUE. Puis j'ai ajouté les IC95 avec confint
result <- confint(pairs(contrast, reverse = TRUE))

#Je retravaille mes résultats pour la présentation. D'abord en les mettant à l'exposant pour avoir des HR, puis en arrondissant.
result$HR <- round(exp(result$estimate), digits=2)
result$lowCI <- round(exp(result$asymp.LCL), digits=2)
result$hiCI <- round(exp(result$asymp.UCL), digits=2)

#Je ne conserve que les rangée (2 et 5) et les colonnes (1, 7, 8, 9) qui m'intéressent
result2 <- result[c(2,5),c(1, 7, 8, 9)]

library(knitr)
library(kableExtra)
kable (result2, caption="HR et IC95 d'un traitement à la prostaglandine sur le risque de conception dans les 5 jours suivant le traitement vs. après 5 jours.")%>%
  kable_styling()
HR et IC95 d’un traitement à la prostaglandine sur le risque de conception dans les 5 jours suivant le traitement vs. après 5 jours.
contrast HR lowCI hiCI
2 (0-5 days 1) - (0-5 days 0) 235.44 51.78 1070.64
5 >5 days 1 - >5 days 0 0.84 0.59 1.20

Dans les 5 jours suivant l’injection le HR est de 235.44 (IC95: 51.78, 1070.64), alors que après 5 jours, le HR est de 0.84 (IC95: 0.59, 1.20).

Le code suivant permettrait d’évaluer une interaction avec le temps représentant un changement d’effet exponentiel durant la période de suivi (i.e., un effet qui diminue ou augmente graduellement, plutôt que de manière catégorique).

#Je commence par créer une prédicteur "temps" logarithmique
pgtrial$lntime <- log(pgtrial$dar)

#Ensuite, je peux tester une interaction entre lntime et tx
library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~  tx*lntime -lntime + lact + thin + herd, data=pgtrial)
summary(PH_fit_pg)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx * lntime - lntime + lact + 
##     thin + herd, data = pgtrial)
## 
##   n= 319, number of events= 264 
## 
##                 coef  exp(coef)   se(coef)       z Pr(>|z|)    
## tx           8.04911 3131.01263    0.59026  13.636   <2e-16 ***
## lact        -0.04273    0.95817    0.03956  -1.080    0.280    
## thin1       -0.11277    0.89336    0.14024  -0.804    0.421    
## herd2       -0.10207    0.90297    0.16959  -0.602    0.547    
## herd3       -0.10909    0.89665    0.17738  -0.615    0.539    
## tx:lntime   -1.80673    0.16419    0.13385 -13.498   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##           exp(coef) exp(-coef) lower .95 upper .95
## tx        3131.0126  0.0003194  984.5795 9956.7790
## lact         0.9582  1.0436592    0.8867    1.0354
## thin1        0.8934  1.1193698    0.6787    1.1760
## herd2        0.9030  1.1074618    0.6476    1.2590
## herd3        0.8967  1.1152585    0.6333    1.2694
## tx:lntime    0.1642  6.0904812    0.1263    0.2134
## 
## Concordance= 0.75  (se = 0.019 )
## Likelihood ratio test= 302.2  on 6 df,   p=<2e-16
## Wald test            = 191.9  on 6 df,   p=<2e-16
## Score (logrank) test = 448.9  on 6 df,   p=<2e-16

Ici aussi l’interaction est significative (P<0.001). Au jour 1 (lntime=0), l’effet du tx est un HR de exp(8.05) ou 3131! Puis, l’effet du traitement en log(HR) diminue de -1.81 à chaque augmentation de 1 log jour. Pour mieux visualiser tout ça, une figure pourrait être utile.

#Je génère le jeu de données avec les valeurs de temps qui m'intéressent (jours 1 à 90) et j'y met les coefficients dont j'ai besoin.
new <- data.frame(tx=8.04, tx_lntime_int=-1.81, time=c(1:90))
new$lntime <- log(new$time)
new$hr <- exp(new$tx + new$lntime*new$tx_lntime_int)

library(ggplot2)
ggplot(new, mapping=aes(x=time, y=hr))+
  geom_line()+
  theme_bw() +
  ylab(label = "Hazard ratio")
**Figure.** Hasard ratio présentant l'effet de la prostaglandine sur le hasard de conception en fonction des jours suivant l'injection.

Figure. Hasard ratio présentant l’effet de la prostaglandine sur le hasard de conception en fonction des jours suivant l’injection.

On note que l’effet du traitement diminue rapidement. Notre modèle 0-5 vs. >5 jours indiquait le même patron (et était peut-être aussi plus simple à expliquer?).

9.5 Évaluation du modèle

9.5.1 Linéarité de la relation (pour les prédicteurs quantitatifs)

La linéarité de la relation est une supposition importante du modèle. Pour les prédicteurs quantitatifs, vous devrez toujours vérifier si cette supposition est bien respectée. Vous pouvez le faire simplement à l’aide du modèle polynomial comme vu précédemment (en ajoutant le \(prédicteur^2\) ou le \(prédicteur^2\) et le \(prédicteur^3\) dans votre modèle).

Une autre possibilité est l’évaluation du graphique du prédicteur quantitatif que nous désirons évaluer par les résiduels de Martingdale d’un modèle sans le prédicteur quantitatif. Une fonction de lissage (comme vu précédemment) permettra de visualiser s’il y a une courbe ou non dans la relation. Les résiduels de Martingdale peuvent être obtenus grâce à la fonction resid(). La relation pourra être représentée grâce à la fonction ggplot de la librairie ggplot2. Par exemple, le code suivant permet d’évaluer la linéarité de la relation entre la variable lact et le hasard de conception.

#Faire rouler le modèle sans le prédicteur continu lact
PH_fit_pg_WO_lact <- coxph(Surv(dar, preg) ~  tx + thin + herd, data=pgtrial)

#Ajouter les résiduels de Martingale dans mon jeu de données
pgtrial$res <- resid(PH_fit_pg_WO_lact) 

library(ggplot2)
ggplot(data=pgtrial, mapping=aes(x=lact, y=res))+
  geom_point() +  #Je demande d'ajouter le nuage de points (un 'scatterplot')
  geom_smooth(method="loess", span=2)+ #Je demande d'ajouter la courbe lissée de type loess. 
  theme_bw()
**Figure.** Graphique des résiduel de Martingdale en fonction de la parité.

Figure. Graphique des résiduel de Martingdale en fonction de la parité.

Dans cet exemple, on note que la relation est curvilinéaire. Notez que le modèle polynomial indique également que le terme au carré est important (P = 0.03) et que la relation n’était donc pas linéaire (voir le code qui suit).

#Lactation centrée sur 2ième parité et au carré
pgtrial$lact_ct <- pgtrial$lact-2
pgtrial$lact_ct_sq <- (pgtrial$lact-2)*(pgtrial$lact-2)

#La régression de cox avec terme polynomiaux
PH_fit_pg_lact_sq <- coxph(Surv(dar, preg) ~  tx + lact_ct + lact_ct_sq + thin + herd, data=pgtrial)
summary(PH_fit_pg_lact_sq)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx + lact_ct + lact_ct_sq + 
##     thin + herd, data = pgtrial)
## 
##   n= 319, number of events= 264 
## 
##                coef exp(coef) se(coef)      z Pr(>|z|)  
## tx          0.19308   1.21298  0.12502  1.544   0.1225  
## lact_ct    -0.17281   0.84129  0.07193 -2.402   0.0163 *
## lact_ct_sq  0.04676   1.04787  0.02108  2.218   0.0266 *
## thin1      -0.09586   0.90859  0.13897 -0.690   0.4903  
## herd2      -0.29904   0.74153  0.16985 -1.761   0.0783 .
## herd3       0.01297   1.01305  0.17417  0.074   0.9406  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##            exp(coef) exp(-coef) lower .95 upper .95
## tx            1.2130     0.8244    0.9494    1.5498
## lact_ct       0.8413     1.1886    0.7307    0.9687
## lact_ct_sq    1.0479     0.9543    1.0054    1.0921
## thin1         0.9086     1.1006    0.6920    1.1930
## herd2         0.7415     1.3486    0.5316    1.0344
## herd3         1.0131     0.9871    0.7201    1.4252
## 
## Concordance= 0.571  (se = 0.02 )
## Likelihood ratio test= 14.66  on 6 df,   p=0.02
## Wald test            = 14.66  on 6 df,   p=0.02
## Score (logrank) test = 14.73  on 6 df,   p=0.02

9.5.2 Valider la supposition de hasard proportionnel

La supposition de risque proportionnel peut être vérifiée en ajoutant une interaction avec le temps (comme présenté à la section “Prédicteur dont l’effet change dans le temps”). Cette interaction peut également être une solution lorsque la supposition de risque proportionnel n’est pas respectée. Mais il existe plusieurs autres méthodes afin de vérifier la supposition de risque proportionnel.

9.5.2.1 Pour un prédicteur catégorique:

Option 1: Comparer graphiquement le log du hasard cummulatif ln H(t) par le log du temps pour chaque niveau du prédicteur. Ces droites devraient être parallèles si les hasards sont proportionnels. Le graphique ln H(t) * ln(t) peut être produit en: 1) faisant tourner un modèle de Kaplan-Meier avec juste la variable qui nous intéresse (tx dans l’exemple qui suit) à l’aide de la fonction survfit(), puis 2) en demandant de produire la figure à partir de cet objet à l’aide de la fonction plot() et de l’argument fun=cloglog (qui indique la figure désirée, c’est à dire ln H(t)*ln(t)).

library(survival)
#Le modèle de K-M avec la variable qui m'intéresse
KM_fit_pg <- survfit(Surv(dar, preg) ~  tx, data=pgtrial)

#La figure ln(H(t)) par ln(temps)
plot(KM_fit_pg, col=c("blue", "red"), fun="cloglog", xlab="days", ylab="Log(H(t))")
**Figure.** Graphique du log du hasard cumulatif (ln H(t)) par le log du temps (ln(t)).

Figure. Graphique du log du hasard cumulatif (ln H(t)) par le log du temps (ln(t)).

Ici, les droites ne sont clairement pas parallèles jusqu’à approximativement 20 à 50 jours.

Option 2: comparer graphiquement les courbes de survie produites à l’aide du modèle de Cox (qui suppose hasard proportionnel) et d’une analyse de survie non-paramétrique (Kaplan-Meier; qui ne suppose rien). Les graphiques devraient être très similaires si les hasards sont proportionnels.

library(survminer)
#La courbe de survie de Kaplan-Meier
ggsurvplot(KM_fit_pg)
**Figure.** Courbes de survie de Kaplan-Meier pour la variable traitement.

Figure. Courbes de survie de Kaplan-Meier pour la variable traitement. 

#Le modèle de cox équivalent
library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~  tx, data=pgtrial)

#La courbe de survie de Cox
ggadjustedcurves(PH_fit_pg, variable="tx")
*Figure.** Courbes de survie de Cox pour la variable traitement.

*Figure.** Courbes de survie de Cox pour la variable traitement.

Notez que les courbes de survie de Kaplan-Meier et de Cox sont passablement différentes entre 0 et 50 jours.

9.5.2.2 Pour un prédicteur catégorique OU quantitatif

Une dernière approche qui permet d’évaluer la supposition de risque proportionnel et qui fonctionne pour des prédicteurs catégoriques OU quantitatifs est l’évaluation d’un graphique des résiduels de Schoenfeld par le logarithme du temps (t). Une fonction de lissage pourra être utilisée afin de visualiser la tendance générale. Si la supposition de risque proportionnel est respectée, une ligne de tendance horizontale (i.e. avec une pente=0) devrait être observée. Notez qu’un résiduel de Schoenfeld différent sera produit pour chacun des prédicteurs du modèle. Vous devrez donc utiliser le résiduel correspondant au prédicteur que vous désirez évaluer.

Pour générer cette figure, vous devrez d’abord créer votre objet modèle de Cox (à l’aide de la fonction coxph()). Puis, vous devez créer un nouvel objet à partir de celui-ci à l’aide de la fonction cox.zph() de la librairie survival. Finalement, à l’aide de la librairie survminer vous pourrez utiliser la fonction ggcoxzph() sur ce dernier objet. Dans l’exemple suivant, je vérifie la supposition de hasard proportionnel pour la variable lact.

#Je génère le modèle de Cox
library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~ tx + lact + thin + herd, data=pgtrial)

#Je génère l'objet cox.zph
fit <- cox.zph(PH_fit_pg)

#Je demande la figure spécifiquement pour la variable lact
library(survminer)
ggcoxzph(fit, var="lact")

Dans ce cas, la ligne est très près d’être horizontale (i.e. pente=0). La supposition de hasard proportionnel est donc probablement respectée pour la variable lact. Notez que le résultat d’un test de Schoenfeld est également présenté. L’hypothèse nulle de ce test est que la pente n’est pas différente de zéro (i.e., la supposition de hasard proportionnel est respectée).

À titre d’exemple, voici la même analyse, mais pour la variable tx. Rappellez-vous, nous avons déjà identifié de différentes manières que la supposition de hasard proportionnel pour cette variable est problématique.

library(survminer)
ggcoxzph(fit, var="tx")

Notez la courbe au tout début (i.e. entre 0 et 28 jours). Le test est près d’être significatif (P = 0.06).

9.5.3 Évaluer impact du non-respect de la supposition de censure non-informative

On ne peut évaluer si la supposition de censure non-informative est respectée, mais ont peut cependant vérifier quel aurait été l’impact d’une censure informative. Pour cela, on doit modifier le jeu de données pour représenter les scénarios les plus extrêmes.
- D’une part toutes les données censurées remplacées par un échec au moment de la censure (corrélation positive).
- D’autre part, ont pourrait remplacer la durée de suivi des données censurées par un temps lointain, mais plausible (corrélation négative).

Ensuite, on éxécutera le modèle de Cox avec ces deux scénarios et on comparera les résultats obtenus à notre modèle initial. On se demandera:
1) est-ce que les conclusions statistiques changent (e.g. un prédicteur n’est plus significatif)?
2) est-ce que les ratio de hasard changent beaucoup (e.g. 2.0 vs. 2.2 ou 2.0 vs. 12.0)?

Par exemple:

#Impact de la censure

#Estimés originaux
library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~ tx + lact + thin + herd, data=pgtrial)

#Corrélation positive complète
#Je créer une nouvelle variable où toutes les observations se terminent par l'événement
pgtrial$preg2 <- 1
#Le modèle avec cette variable
PH_fit_pg_pos <- coxph(Surv(dar, preg2) ~ tx + lact + thin + herd, data=pgtrial)

#Corrélation négative complète
#Je créer une nouvelle variable où toutes les vaches non-gestantes auraient vécu jusqu'à au moins 500 JEL sans conception avant d'être finalement réformées
pgtrial$dar2 <- ifelse(pgtrial$preg==1,pgtrial$dar,500) 
#Le modèle avec cette variable
PH_fit_pg_neg <- coxph(Surv(dar2, preg) ~ tx + lact + thin + herd, data=pgtrial)

#tableau récapitulatif
tableau <- cbind("Estimés originaux"=exp(PH_fit_pg$coefficients), "Corrélation positive complète"=exp(PH_fit_pg_pos$coefficients), "Corrélation négative complète"=exp(PH_fit_pg_neg$coefficients)) 

library(knitr)
library(kableExtra)
kable (round(tableau, digits=2), caption="HR d'un traitement à la prostaglandine sur le risque de conception. Modèle initial, puis modèles supposant corrélation positive et négative complètes.")%>%
  kable_styling()
HR d’un traitement à la prostaglandine sur le risque de conception. Modèle initial, puis modèles supposant corrélation positive et négative complètes.
Estimés originaux Corrélation positive complète Corrélation négative complète
tx 1.22 1.26 1.12
lact 0.96 1.00 0.93
thin1 0.86 0.86 0.94
herd2 0.75 0.80 0.77
herd3 1.04 1.02 1.05

Ici, on note peu de différence des ratio de hasard d’un modèle à l’autre. Notez que la fonction ggforest() de la librairie survminer produit une autre manière de visualiser/comparer nos résultats rapidement. Par exemple, pour nos 3 modèles:

library(survminer)
ggforest(PH_fit_pg, main = "HR modèle initial")

ggforest(PH_fit_pg_pos, main = "HR corrélation positive complète")

ggforest(PH_fit_pg_neg, main = "HR corrélation négative complète")

9.5.4 Observations extrêmes

Les résiduels de déviance peuvent être utilisés afin d’identifier les observations extrêmes. Ont peut les produire à l’aide de la fonction resid() en spécifiant type="deviance". On pourra ensuite les représenter graphiquement en fonction du temps à l’aide de la fonction ggplot(). On devra aussi tenter d’identifier si ces observations ont un profil de prédicteurs et variable dépendante commun.

#Ajouter les résiduels de déviance à ma table
pgtrial$res.dev <- resid(PH_fit_pg, type="deviance")

library(ggplot2)
ggplot(data=pgtrial, mapping=aes(x=dar, y=res.dev)) +
          geom_point() +
          theme_bw()
**Figure.** Résiduels de déviance en fonction du temps.

Figure. Résiduels de déviance en fonction du temps. 

#Je pourrais maintenant filtrer cette table pour ne conserver que les résiduels standardisés larges (en fait, il n'y en avait aucun >3.0 ou <-3.0)
res_large <- subset(pgtrial, (res.dev >=2.0 | res.dev<=-2.0))

kable (res_large, caption="Observations avec les résiduels les plus larges.")%>%
  kable_styling()
Observations avec les résiduels les plus larges.
herd cow tx lact thin dar preg time5 lntime res lact_ct lact_ct_sq preg2 dar2 res.dev
1 1 1 0 1 0 1 1 0-5 days 0.0000000 0.9917920 -1 1 1 1 2.734574
2 1 2 1 4 1 1 1 0-5 days 0.0000000 0.9916056 2 4 1 1 2.764111
3 1 3 1 1 0 2 1 0-5 days 0.6931472 0.9778236 -1 1 1 2 2.351804
73 1 76 1 1 0 277 0 >5 days 5.6240175 -3.4421658 -1 1 1 500 -2.710981
74 2 78 0 2 1 1 1 0-5 days 0.0000000 0.9947488 0 0 1 1 2.902334
75 2 79 1 4 0 1 1 0-5 days 0.0000000 0.9923152 2 4 1 1 2.813330
76 2 80 1 1 0 2 1 0-5 days 0.6931472 0.9830284 -1 1 1 2 2.467808
176 2 180 1 2 0 201 0 >5 days 5.3033049 -2.0393102 0 0 1 500 -2.028332
180 2 184 1 2 0 250 0 >5 days 5.5214609 -2.4248224 0 0 1 500 -2.208513
183 2 187 1 3 1 288 0 >5 days 5.6629605 -2.2021736 1 1 1 500 -2.090547
185 2 189 0 1 0 346 0 >5 days 5.8464388 -2.3808125 -1 1 1 500 -2.237670
314 3 318 0 1 1 262 0 >5 days 5.5683445 -2.4382604 -1 1 1 500 -2.277784
315 3 319 0 2 1 262 0 >5 days 5.5683445 -2.4382604 0 0 1 500 -2.228663
316 3 320 0 4 1 287 0 >5 days 5.6594822 -2.5542742 2 4 1 500 -2.182537
317 3 321 0 2 1 288 0 >5 days 5.6629605 -2.5542742 0 0 1 500 -2.279806
318 3 322 0 3 1 308 0 >5 days 5.7300998 -2.8241677 1 1 1 500 -2.342337
319 3 323 0 2 1 320 0 >5 days 5.7683210 -2.8241677 0 0 1 500 -2.393963

9.5.5 Observations influentes

Les résiduels de score ou les delta-betas peuvent être utilisés afin d’identifier les observations influentes. Notez que, comme pour les résiduels de Schoenfeld, un résiduel de score (et un delta-beta) différent sera produit pour chacun des prédicteurs du modèle. Vous devrez donc utiliser le résiduel correspondant au prédicteur que vous désirez évaluer.

Ont peut également les produire à l’aide de la fonction resid(), l’argument type="score" génèrera les résiduels de Score. type="dfbetas" sera utilisé pour les delta-betas. Ont pourra ensuite les représenter graphiquement en fonction du temps à l’aide de la fonction ggplot(). Lorsque représenté en fonction du temps, ces résiduels ressembleront à un genre de « ventilateur ». Les points en dehors du ventilateur seront les plus influants. On devra tenter d’identifier si ces observations ont un profil de prédicteurs et de variable dépendante particulier.

Le code suivant permettra, par exemple, de produire les résiduels de score pour chacun des prédicteurs et de visualiser la figure pour la variable tx. Pour la figure, j’ai utilisé la librairie ggrepel et la fonction geom_text_repel() qui me permet d’identifier les points sur la figure.

#Créer les résiduels de déviance dans une table
y <- data.frame(resid(PH_fit_pg, type="score"))

#Joindre ces éléments dans ma table initiale
#Renommer les variables
library(data.table)
setnames(y, old = c('tx','lact', 'thin1', 'herd2', 'herd3'), new = c('score_tx','score_lact', 'score_thin', 'score_herd2', 'score_herd3'))

#Combiner les tables
a <- cbind(pgtrial, y) 

#Visualiser résiduels de score de tx en fonction du temps
library(ggplot2)
library(ggrepel)
ggplot(data=a, mapping=aes(x=dar, y=score_tx)) +
          geom_point() +
          theme_bw() +
          geom_text_repel(aes(label = cow))
**Figure.** Résiduels de score de la variable TX en fonction du temps.

Figure. Résiduels de score de la variable TX en fonction du temps.

9.6 Pour aller plus loin

9.6.1 Erreurs-types robustes

Lorsqu’il y a regroupement des observations (e.g. des animaux regroupés en troupeaux), la supposition d’indépendance des observations n’est pas respectée. Comme vu au cours, ont poura remédier à ce problème en incluant la variable « groupe » (e.g. l’identifiant du troupeau) comme prédicteur ou en stratifiant l’analyse de Cox par cette variable. Les erreur-types robustes peuvent aussi être utilisées pour régler ce problème. L’argument cluster() permettra le calcul d’erreur-types robustes. On indiquera entre parenthèse une variable décrivant l’unité d’analyse (ici la vache).

library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~ tx + lact + thin + cluster(cow), data=pgtrial)
summary(PH_fit_pg)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx + lact + thin, data = pgtrial, 
##     cluster = cow)
## 
##   n= 319, number of events= 264 
## 
##           coef exp(coef) se(coef) robust se      z Pr(>|z|)
## tx     0.15620   1.16906  0.12371   0.12261  1.274    0.203
## lact  -0.05054   0.95071  0.04020   0.03820 -1.323    0.186
## thin1 -0.10009   0.90476  0.12556   0.12347 -0.811    0.418
## 
##       exp(coef) exp(-coef) lower .95 upper .95
## tx       1.1691     0.8554    0.9193     1.487
## lact     0.9507     1.0518    0.8821     1.025
## thin1    0.9048     1.1053    0.7103     1.152
## 
## Concordance= 0.547  (se = 0.021 )
## Likelihood ratio test= 4.4  on 3 df,   p=0.2
## Wald test            = 4.28  on 3 df,   p=0.2
## Score (logrank) test = 4.38  on 3 df,   p=0.2,   Robust = 4.32  p=0.2
## 
##   (Note: the likelihood ratio and score tests assume independence of
##      observations within a cluster, the Wald and robust score tests do not).

9.6.2 Régression de Cox à fragilité partagée

Un modèle de régression de Cox à fragilité partagée peut-être utilisé afin de prendre en compte le regroupement des observations (i.e., la dépendance entre les observations). L’argument frailty() permettra d’indiquer comment les données sont regroupées (i.e. permet d’ajouter un effet aléatoire groupe). Notez qu’on ne pourra indiquer qu’un seul niveau de regroupement (e.g., vaches regroupées par troupeaux).

library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~ tx + lact + thin + frailty(herd), data=pgtrial)
summary(PH_fit_pg)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx + lact + thin + frailty(herd), 
##     data = pgtrial)
## 
##   n= 319, number of events= 264 
## 
##               coef     se(coef) se2     Chisq DF   p    
## tx             0.17683 0.12456  0.12417 2.02  1.00 0.160
## lact          -0.04668 0.04058  0.04034 1.32  1.00 0.250
## thin1         -0.12589 0.13067  0.12774 0.93  1.00 0.340
## frailty(herd)                           2.75  0.91 0.086
## 
##         exp(coef) exp(-coef) lower .95 upper .95
## tx         1.1934     0.8379    0.9349     1.523
## lact       0.9544     1.0478    0.8814     1.033
## thin1      0.8817     1.1342    0.6825     1.139
## gamma:1    1.0349     0.9663    0.8691     1.232
## gamma:2    0.9016     1.1091    0.7568     1.074
## gamma:3    1.0635     0.9403    0.8984     1.259
## 
## Iterations: 7 outer, 20 Newton-Raphson
##      Variance of random effect= 0.01113406   I-likelihood = -1307.3 
## Degrees of freedom for terms= 1.0 1.0 1.0 0.9 
## Concordance= 0.56  (se = 0.02 )
## Likelihood ratio test= 8.57  on 3.85 df,   p=0.07

9.7 Travaux pratiques 8 - Analyses de survie non-paramétriques

9.7.1 Exercices

Pour ce TP utilisez le fichier pgtrial.csv (voir description VER p.824). Cette étude est un essai clinique randomisé sur l’effet de l’administration d’une dose de prostaglandine vs. d’un placebo (la variable tx; 0=placebo, 1=prostaglandines) au début de la période de reproduction sur le nombre de jours (la variable dar) jusqu’à la conception (la variable preg, 0=censure, 1=gestation). L’hypothèse était que l’administration de prostaglandine réduirait le nombre de jours jusqu’à la conception. Les 319 vaches de cette étude étaient suivies jusqu’à un maximum de 346 jours en lait. Trois autres prédicteurs étaient aussi évalués : la parité (lact; 1, 2, 3…), l’état de chair (thin; 0=normal, 1=maigre) et le troupeau d’appartenance (herd; 3 troupeaux).

  1. Combien des 319 vaches ont réussi à concevoir et combien étaient toujours non-gestante (i.e. observations censurées) à la fin de la période de suivi?

  2. Il y a donc passablement d’observations censurées dans ce jeu de données, une analyse de survie serait donc appropriée. Produisez la table et le graphique de survie de Kaplan-Meier.

2.1. Quelle proportion et quel nombre de vaches avait « survécu » (i.e. n’avait pas eu de conception) à 5 jours suivant l’administration des traitement? Notez, que suite à l’administration de prostaglandines, une chaleur est souvent notée dans les 2-5 jours, suivant l’injection.

2.2. Quel était le temps médian jusqu’à la conception et quel était son IC95%?

  1. Comparer maintenant les fonctions de survie des vaches ayant reçu la prostaglandine vs. le placebo.

3.1. Visuellement que notez-vous lorsque vous comparez les fonctions de survie de ces deux groupes de vaches?

3.2. Quelles étaient les proportions de vaches gestantes dans les groupes prostaglandines vs. placebo aux jours 5, 26 et 100?

3.3. Les fonctions de survie des deux groupes de traitement sont-elles statistiquement différentes?

3.4. Comme la conception est, en général, un événement positif, les chercheurs trouveraient plus approprié de présenter la fonction d’échec plutôt que la fonction de survie dans leur article. Représentez les fonctions d’échec des groupes prostaglandines et placebo avec leurs IC95%. Que représente maintenant l’axe des Y?

3.5. Lorsque vous comparer l’IC95% de la fonction d’échec de Kaplan-Meier du groupe prostaglandines à la fonction d’échec du groupe placebo. Arrivez-vous aux mêmes conclusions que celles obtenues à l’aide des tests de Wilcoxon et Log-rank?

3.6. Comparez finalement les fonctions de survie (ou d’échec) entre les groupes de traitement, mais par troupeau d’appartenance.

9.7.2 Code R et réponses

Pour ce TP utilisez le fichier pgtrial.csv (voir description VER p.824). Cette étude est un essai clinique randomisé sur l’effet de l’administration d’une dose de prostaglandine vs. d’un placebo (la variable tx; 0=placebo, 1=prostaglandines) au début de la période de reproduction sur le nombre de jours (la variable dar) jusqu’à la conception (la variable preg, 0=censure, 1=gestation). L’hypothèse était que l’administration de prostaglandine réduirait le nombre de jours jusqu’à la conception. Les 319 vaches de cette étude étaient suivies jusqu’à un maximum de 346 jours en lait. Trois autres prédicteurs étaient aussi évalués : la parité (lact; 1, 2, 3…), l’état de chair (thin; 0=normal, 1=maigre) et le troupeau d’appartenance (herd; 3 troupeaux).

#J'importe la base de données
pgtrial <-read.csv(file="pgtrial.csv", header=TRUE, sep=";")

#J'indique les variables catégoriques dans mon jeu de données
pgtrial$thin <- factor(pgtrial$thin) 
pgtrial$tx <- factor(pgtrial$tx) 
pgtrial$herd <- factor(pgtrial$herd)
  1. Combien des 319 vaches ont réussi à concevoir et combien étaient toujours non-gestante (i.e. observations censurées) à la fin de la période de suivi?
library(summarytools)
print(dfSummary(pgtrial$preg), method='render')
## pgtrial$preg was converted to a data frame

Data Frame Summary

pgtrial

Dimensions: 319 x 1
Duplicates: 317
No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
1 preg [integer] Min : 0 Mean : 0.8 Max : 1
0:55(17.2%)
1:264(82.8%)
 319 (100.0%) 0 (0.0%)

Generated by summarytools 0.9.8 (R version 4.0.4)
2022-02-11

Réponse: À la fin de la période de suivi, 264 vaches (83%) étaient gestantes et 55 étaient non-gestantes (17%).

  1. Il y a donc passablement d’observations censurées dans ce jeu de données, une analyse de survie serait donc appropriée. Produisez la table et le graphique de survie de Kaplan-Meier.
library(survival)

#Produire la table de Kaplan-Meier
km_fit <- survfit(Surv(dar, preg) ~ 1, data=pgtrial)
#summary(km_fit)   #La fonction summary() me permet de visualiser la table de Kaplan-Meier. Celle-ci est très longue (160 lignes) je le laisse donc en "commentaire" afin de ne pas surcharger ce document.

#Produire la courbe de survie
library(survminer)
survie <- ggsurvplot(km_fit, conf.int = TRUE)
survie$plot +theme_bw()

2.1. Quelle proportion et quel nombre de vaches avait « survécu » (i.e. n’avait pas eu de conception) à 5 jours suivant l’administration des traitement? Notez, que suite à l’administration de prostaglandines, une chaleur est souvent notée dans les 2-5 jours, suivant l’injection.

summary(survfit(Surv(dar, preg) ~ 1, data=pgtrial), times = 5)
## Call: survfit(formula = Surv(dar, preg) ~ 1, data = pgtrial)
## 
##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
##     5    277      42    0.868  0.0189        0.832        0.906

Répoinse: 86.8% (IC95: 83.2, 90.6) des vaches n’avaient pas encore eu une conception au jour 5.

2.2. Quel était le temps médian jusqu’à la conception et quel était son IC95%?

library(survival)
#Le temps médian de survie
survfit(Surv(dar, preg) ~ 1, data=pgtrial)
## Call: survfit(formula = Surv(dar, preg) ~ 1, data = pgtrial)
## 
##       n  events  median 0.95LCL 0.95UCL 
##     319     264      68      55      77

Réponse: Le temps médian jusqu’à la conception était 68 jours (IC95: 55 à 77 jours).

  1. Comparer maintenant les fonctions de survie des vaches ayant reçu la prostaglandine vs. le placebo.
library(survival)

survfit(Surv(dar, preg) ~ tx, data=pgtrial)
## Call: survfit(formula = Surv(dar, preg) ~ tx, data = pgtrial)
## 
##        n events median 0.95LCL 0.95UCL
## tx=0 168    139     69      58      81
## tx=1 151    125     66      44      84
km_fit_pg <- survfit(Surv(dar, preg) ~ tx, data=pgtrial)

library(survminer)
ggsurvplot(km_fit_pg, conf.int = TRUE)

3.1. Visuellement que notez-vous lorsque vous comparez les fonctions de survie de ces deux groupes de vaches?
Réponse: On note que les fonctions diffèrent passablement très tôt suite au traitement. Par la suite, les fonctions deviennent de plus en plus similaires et sont assez équivalente à partir du jour 75, environ.

3.2. Quelles étaient les proportions de vaches gestantes dans les groupes prostaglandines vs. placebo aux jours 5, 26 et 100?

summary(survfit(Surv(dar, preg) ~ tx, data=pgtrial), times = c(5, 26, 100))
## Call: survfit(formula = Surv(dar, preg) ~ tx, data = pgtrial)
## 
##                 tx=0 
##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
##     5    165       4    0.976  0.0118        0.953        1.000
##    26    127      38    0.749  0.0336        0.686        0.817
##   100     54      62    0.360  0.0380        0.292        0.442
## 
##                 tx=1 
##  time n.risk n.event survival std.err lower 95% CI upper 95% CI
##     5    112      38    0.748  0.0354        0.682        0.821
##    26    104       9    0.687  0.0378        0.617        0.766
##   100     43      50    0.326  0.0398        0.257        0.415

Réponse: la proportion de vaches gestantes serait l’inverse de la probabilité de survie. Donc:
- À 5 jours: placebo 2.4% (IC95: 0, 4.7), prostaglandine 25.2% (IC95: 17.9, 31.8)
- À 26 jours: placebo 25.1% (IC95: 18.3, 31.4), prostaglandine 31.3% (IC95: 23.4, 38.3)
- À 100 jours: placebo 64.0% (IC95: 55.8, 70.8), prostaglandine 67.4% (IC95: 58.5, 74.3)

3.3. Les fonctions de survie des deux groupes de traitement sont-elles statistiquement différentes?

library(survival)
survdiff(Surv(dar, preg) ~ tx, data=pgtrial, rho=0)
## Call:
## survdiff(formula = Surv(dar, preg) ~ tx, data = pgtrial, rho = 0)
## 
##        N Observed Expected (O-E)^2/E (O-E)^2/V
## tx=0 168      139      149     0.677      1.59
## tx=1 151      125      115     0.878      1.59
## 
##  Chisq= 1.6  on 1 degrees of freedom, p= 0.2
survdiff(Surv(dar, preg) ~ tx, data=pgtrial, rho=1)
## Call:
## survdiff(formula = Surv(dar, preg) ~ tx, data = pgtrial, rho = 1)
## 
##        N Observed Expected (O-E)^2/E (O-E)^2/V
## tx=0 168     75.4     85.5      1.18      3.96
## tx=1 151     77.6     67.6      1.50      3.96
## 
##  Chisq= 4  on 1 degrees of freedom, p= 0.05

Réponse: Le test de Wilcoxon indique que les fonctions de survie sont différentes (P = 0.05), mais le test de Log-rank indique qu’elles ne sont pas différentes (P = 0.20). Les résultats sont mitigés parce que dans ce cas, les différences étaient surtout observées dans les premiers jours suivant le traitement (ce que le test de Wilcoxon à retenu). En fait, nos connaissances en physiologie de la reproduction supporteraient un effet important des prostaglandines dans les 2-5 jours suivant l’injection. Par la suite, il serait surprenant de voir un quelconque effet positif.

Le test de Log-rank assigne le même poids à tous les points dans le temps. Pour ce test, les différences entre groupes aux jours 100, 150 ou même 200 sont donc aussi importantes que les différences au jour 5. Le test de Wilcoxon, par contre, donnera plus de poids aux premières périodes de temps lorsque la taille d’échantillon est encore large.

3.4. Comme la conception est, en général, un événement positif, les chercheurs trouveraient plus approprié de présenter la fonction d’échec plutôt que la fonction de survie dans leur article. Représentez les fonctions d’échec des groupes prostaglandines et placebo avec leurs IC95%. Que représente maintenant l’axe des Y?

library(survminer)
ggsurvplot(km_fit_pg, conf.int = TRUE, fun = "event")

Réponse: L’axe des Y représente maintenant la probabilité de conception (plutôt que la probabilité de non-conception).

3.5. Lorsque vous comparer l’IC95% de la fonction d’échec de Kaplan-Meier du groupe prostaglandines à la fonction d’échec du groupe placebo. Arrivez-vous aux mêmes conclusions que celles obtenues à l’aide des tests de Wilcoxon et Log-rank?

Réponse: Oui, on voit que c’est en début de suivi que l’IC95 du groupe prostaglandines n’inclus pas la fonction d’échec du groupe placebo. À partir du jour 25 environ l’IC95 d’un groupe de traitement semble inclure la fonction de survie de l’autre, mais c’est encore plus clair à partir du jour 60 (approximativement). J’ai ajouté des lignes de référence à 25 et 60 jours dans la figure plus bas afin d’illustrer ces observations.

library(survminer)
ggsurv <- ggsurvplot(km_fit_pg, conf.int = TRUE, fun = "event")

ggsurv$plot +
  geom_vline(xintercept = 25, linetype=2)+
  geom_vline(xintercept = 60, linetype=2)

3.6. Comparez finalement les fonctions de survie (ou d’échec) entre les groupes de traitement, mais par troupeau d’appartenance.

library(survival)

survfit(Surv(dar, preg) ~ tx + herd, data=pgtrial)
## Call: survfit(formula = Surv(dar, preg) ~ tx + herd, data = pgtrial)
## 
##               n events median 0.95LCL 0.95UCL
## tx=0, herd=1 36     34     70      54     103
## tx=0, herd=2 57     43     70      63      88
## tx=0, herd=3 75     62     67      43     105
## tx=1, herd=1 37     29     73      47     109
## tx=1, herd=2 55     42     88      49     118
## tx=1, herd=3 59     54     44      26      77
km_fit_pg <- survfit(Surv(dar, preg) ~ tx + herd, data=pgtrial)
survdiff(Surv(dar, preg) ~ tx + herd, data=pgtrial, rho=0)
## Call:
## survdiff(formula = Surv(dar, preg) ~ tx + herd, data = pgtrial, 
##     rho = 0)
## 
##               N Observed Expected (O-E)^2/E (O-E)^2/V
## tx=0, herd=1 36       34     30.0     0.533     0.616
## tx=0, herd=2 57       43     48.9     0.713     0.894
## tx=0, herd=3 75       62     70.1     0.945     1.325
## tx=1, herd=1 37       29     26.2     0.296     0.338
## tx=1, herd=2 55       42     52.3     2.026     2.595
## tx=1, herd=3 59       54     36.5     8.450    10.145
## 
##  Chisq= 13.5  on 5 degrees of freedom, p= 0.02
survdiff(Surv(dar, preg) ~ tx +herd, data=pgtrial, rho=1)
## Call:
## survdiff(formula = Surv(dar, preg) ~ tx + herd, data = pgtrial, 
##     rho = 1)
## 
##               N Observed Expected (O-E)^2/E (O-E)^2/V
## tx=0, herd=1 36     17.4     18.0    0.0202    0.0337
## tx=0, herd=2 57     23.7     28.7    0.8981    1.6276
## tx=0, herd=3 75     34.3     38.7    0.4946    0.9882
## tx=1, herd=1 37     18.1     16.3    0.2004    0.3254
## tx=1, herd=2 55     25.0     28.1    0.3385    0.6322
## tx=1, herd=3 59     34.6     23.2    5.5361    9.3234
## 
##  Chisq= 10.8  on 5 degrees of freedom, p= 0.06
ggsurv <- ggsurvplot(km_fit_pg, conf.int = TRUE, fun="event")
   
ggsurv$plot +theme_bw() + 
  theme (legend.position = "right")+
  facet_grid( ~ herd)

Réponse: Le log-rank est significatif (P=0.02). Mais on ne peut rapporter l’effet du traitement séparément de l’effet du troupeau. C’est plutôt un test de l’ensemble des catégories de traitement*troupeau. On voit que les analyses non-paramétriques sont donc assez limitées pour modéliser l’effet de 2 prédicteurs (même catégoriques).

9.8 Travaux pratiques 9 - Analyses de survie semi-paramétriques

9.8.1 Exercices

Pour ce TP utilisez le fichier pgtrial.csv (voir description VER p.824).

Cette étude est un essai clinique randomisé sur l’effet de l’administration d’une dose de prostaglandine vs. d’un placebo (tx) au début de la période de reproduction sur le nombre de jours (dar) jusqu’à la conception (preg). L’hypothèse était que l’administration de prostaglandine réduirait le nombre de jours jusqu’à la conception. Les 319 vaches de cette étude étaient suivies jusqu’à un maximum de 346 jours en lait. Trois autres prédicteurs étaient aussi évalués: le nombre de lactation (lact; 1, 2, 3…), l’état de chair (thin; 0=normal, 1=thin) et le troupeau (herd; 3 troupeaux).

Comme vous l’avez vu au dernier TP, les modèles non-paramétriques sont plutôt limités lorsque l’on désire évaluer l’effet de plus d’un prédicteur. Les modèles de Cox (i.e. semi-paramétriques), par contre, offrent les mêmes possibilités qu’un modèle de régression (e.g. ajustement pour facteurs confondants, prédicteur quantitatif, interaction).

  1. À l’aide d’un modèle de Cox, évaluer l’effet du groupe de traitement (tx) sur le nombre de jours (dar) jusqu’à la conception (preg) tout en contrôlant les facteurs confondants thin, lact et herd.

1.1. Comment interprétez-vous les résultats de ce modèle pour la variable tx?

1.2. Quelles sont les suppositions que vous aurez à vérifier pour ce modèle de Cox?

1.3. Vérifiez que le hasard est bien proportionnel pour la variable tx (i.e. que l’effet de tx ne change pas dans le temps).

1.4. Vérifiez que la linéarité de la relation est bien respectée pour la variable lact.

  1. Vos évaluations préliminaires vous ont permis de conclure que l’effet du traitement change dans le temps et que la relation entre lact et H(t) est une courbe. Vous décidez donc du modèle suivant:

\(Ln H(t) = ln H_0(t) + β_1*tx + β_2*tx*time + β_3*(lact-1) + β_4*(lact-1)^2 + β_5*thin + β_6*herd\)

Où time est une variable catégorique ≤5 jours vs. >5 jours.

2.1. Comment change le risque de conception dans les 5 jours suivant le traitement lorsque les prostaglandines sont utilisées plutôt qu’un placebo? Et après 5 jours?

2.2. En supposant qu’une vache resterait dans un troupeau jusqu’à 500 jours suivant le traitement avant d’être réformée, évaluez l’effet qu’aurait pu avoir une censure informative.

2.3. Quelles sont les observations avec les résiduels les plus larges? Ont-elles quelquechose en commun?

2.4. Quelles sont les observations les plus influentes sur les coefficients \(tx\) et \(tx*time\)? Ont-elles quelquechose en commun?

9.8.2 Code R et réponses

Pour ce TP utilisez le fichier pgtrial.csv (voir description VER p.824).

pgtrial <-read.csv(file="pgtrial.csv", header=TRUE, sep=";")
head(pgtrial)
##   herd cow tx lact thin dar preg
## 1    1   1  0    1    0   1    1
## 2    1   2  1    4    1   1    1
## 3    1   3  1    1    0   2    1
## 4    1   4  1    1    0   3    1
## 5    1   5  1    6    0   3    0
## 6    1   6  1    1    0   3    1
#J'indique les variables catégoriques dans mon jeu de données
pgtrial$thin <- factor(pgtrial$thin) 
pgtrial$herd <- factor(pgtrial$herd)

Cette étude est un essai clinique randomisé sur l’effet de l’administration d’une dose de prostaglandine vs. d’un placebo (tx) au début de la période de reproduction sur le nombre de jours (dar) jusqu’à la conception (preg). L’hypothèse était que l’administration de prostaglandine réduirait le nombre de jours jusqu’à la conception. Les 319 vaches de cette étude étaient suivies jusqu’à un maximum de 346 jours en lait. Trois autres prédicteurs étaient aussi évalués: le nombre de lactation (lact; 1, 2, 3…), l’état de chair (thin; 0=normal, 1=thin) et le troupeau (herd; 3 troupeaux).

Comme vous l’avez vu au dernier TP, les modèles non-paramétriques sont plutôt limités lorsque l’on désire évaluer l’effet de plus d’un prédicteur. Les modèles de Cox (i.e. semi-paramétriques), par contre, offrent les mêmes possibilités qu’un modèle de régression (e.g. ajustement pour facteurs confondants, prédicteur quantitatif, interaction).

  1. À l’aide d’un modèle de Cox, évaluer l’effet du groupe de traitement (tx) sur le nombre de jours (dar) jusqu’à la conception (preg) tout en contrôlant les facteurs confondants thin, lact et herd.
library(survival)
library(survminer)
PH_fit_pg <- coxph(Surv(dar, preg) ~ tx + lact + thin + herd, data=pgtrial)
ggforest(PH_fit_pg)

1.1. Comment interprétez-vous les résultats de ce modèle pour la variable tx?
Réponse: Le groupe de traitement (tx) n’est pas significativement associé au temps jusqu’à la saillie fécondante (P =0.12). Lorsque thin, lact et herd sont gardés constants, le risque de conception à n’importe quel moment était multiplié par 1.22 (i.e. le Hazard Ratio), mais l’IC 95% (0.95 à 1.6) inclus la valeur nulle (1.0).

1.2. Quelles sont les suppositions que vous aurez à vérifier pour ce modèle de Cox?
Réponse:
- Pour chacun des prédicteurs (i.e. tx, lact, thin et herd), on devra vérifier que le hasard est propotionnel (i.e. effet ne change pas dans le temps);
- Linéarité de la relation pour lact qui est un prédicteur quantitatif (on pourrait tester un terme au carré, par exemple);
- Censure non-informative;
- Indépendance des observations (i.e. pas de regroupement).

1.3. Vérifiez que le hasard est bien proportionnel pour la variable tx (i.e. que l’effet de tx ne change pas dans le temps).
Réponse: Ont peut s’y prendre de trois manières:
1) graphique de ln H(t) * ln du temps pour chaque niveau du prédicteur;
2) comparer courbes de survie non-paramétrique et semi-paramétrique;
3) ajouter une interaction avec le temps et vérifier si statistiquement significative (i.e. P < 0.05).

library(survival)
#Le modèle de K-M avec la variable qui m'intéresse
KM_fit_pg <- survfit(Surv(dar, preg) ~  tx, data=pgtrial)

#La figure ln(H(t)) par ln(temps)
plot(KM_fit_pg, col=c("blue", "red"), fun="cloglog", xlab="days", ylab="Log(H(t))")
**Figure.** Graphique du log du hasard cumulatif (ln H(t)) par le log du temps (ln(t)).

Figure. Graphique du log du hasard cumulatif (ln H(t)) par le log du temps (ln(t)).

Réponse: Dans ce cas, le fait que les courbes ne sont pas parallèles indique que le hasard n’est pas proportionnel dans le temps.

library(survminer)
#La courbe de survie de Kaplan-Meier
ggsurvplot(KM_fit_pg)
**Figure.** Courbes de survie de Kaplan-Meier pour la variable traitement.

Figure. Courbes de survie de Kaplan-Meier pour la variable traitement. 

#Le modèle de cox équivalent
library(survival)
PH_fit_pg <- coxph(Surv(dar, preg) ~  tx, data=pgtrial)

#La courbe de survie de Cox
ggadjustedcurves(PH_fit_pg, variable="tx")
**Figure.** Courbes de survie de Cox pour la variable traitement.

Figure. Courbes de survie de Cox pour la variable traitement.

Réponse: La courbe de survie de Cox donne un résultat similaire: les courbes de Cox et de Kaplan-Meier sont passablement différentes (surtout avant 50 jours), cela indique que le hasard n’est pas proportionnel dans le temps.

Finalement, on pourrait aussi tester une interaction entre tx et le temps. Par exemple:

#Créer ma variable temps
pgtrial$t_cat <- cut(pgtrial$dar, breaks = c(0, 5, 26, Inf),labels = c("0-5 days", "5-26 days", ">26 days"))

#Le modèle de Cox avec l'interaction
library(survival)
PH_fit_pg_t_cat <- coxph(Surv(dar, preg) ~  tx + tx*t_cat - t_cat, data=pgtrial)
summary(PH_fit_pg_t_cat)
## Call:
## coxph(formula = Surv(dar, preg) ~ tx + tx * t_cat - t_cat, data = pgtrial)
## 
##   n= 319, number of events= 264 
## 
##                         coef  exp(coef)   se(coef)      z     Pr(>|z|)    
## tx                  5.696984 297.967370   0.597725  9.531      < 2e-16 ***
## tx:t_cat5-26 days  -3.485914   0.030626   0.650500 -5.359 0.0000000838 ***
## tx:t_cat>26 days   -5.985539   0.002515   0.603662 -9.915      < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
##                    exp(coef) exp(-coef)  lower .95 upper .95
## tx                297.967370   0.003356 92.3388206 961.50842
## tx:t_cat5-26 days   0.030626  32.652272  0.0085582   0.10960
## tx:t_cat>26 days    0.002515 397.636926  0.0007703   0.00821
## 
## Concordance= 0.681  (se = 0.018 )
## Likelihood ratio test= 219.6  on 3 df,   p=<2e-16
## Wald test            = 121  on 3 df,   p=<2e-16
## Score (logrank) test = 485.2  on 3 df,   p=<2e-16
#Je pourrais faire un test de rapport de vraisemblance pour comparer les modèles avec et sans l'interaction
library(lmtest)
lrtest(PH_fit_pg_t_cat, PH_fit_pg)
## Likelihood ratio test
## 
## Model 1: Surv(dar, preg) ~ tx + tx * t_cat - t_cat
## Model 2: Surv(dar, preg) ~ tx
##   #Df  LogLik Df  Chisq Pr(>Chisq)    
## 1   3 -1200.1                         
## 2   1 -1309.0 -2 217.78  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Réponse: Notez que vous pouver « traiter » la variable temps comme bon vous le désirez en fonction de ce que vous connaissez de la biologie. Ici, j’ai catégorisé le temps (t_cat) de cette manière : <5 jours vs. 5-26 jours vs. >26 jours. Mon test de rapport de vraisemblance me donne une valeur de P < 0.001 pour le groupe de variables indicateurs \(tx*tcat\). Cela indique donc que l’effet du traitement (tx) sur le risque de conception n’est pas le même dans les 5 jours suivant le traitement vs. les jours 5 à 26 vs. après 26 jours . i.e. les hasards ne sont pas proportionnels. Afin de mieux illuster ces différences j’ai réorganisé mes résultats dans la table suivante.

library(emmeans)
#Je génère d'abord l'objet contrast à partir de mon modèle
contrast <- emmeans(PH_fit_pg_t_cat, c("tx", "t_cat")) 

#Je demande les comparaisons pairées, je voulais voir Tx=1 vs Tx=0, j'ai donc du utilisé reverse=TRUE. Puis j'ai ajouté les IC95 avec confint
result <- confint(pairs(contrast, reverse = TRUE))

#Je retravaille mes résultats pour la présentation. D'abord en les mettant à l'exposant pour avoir des HR, puis en arrondissant.
result$HR <- round(exp(result$estimate), digits=2)
result$lowCI <- round(exp(result$asymp.LCL), digits=2)
result$hiCI <- round(exp(result$asymp.UCL), digits=2)

#Je ne conserve que les rangée (4, 8 et 13) et les colonnes (1, 7, 8, 9) qui m'intéressent
result2 <- result[c(4, 8, 13),c(1, 7, 8, 9)]

library(knitr)
library(kableExtra)
kable (result2, caption="HR et IC95 d'un traitement à la prostaglandine sur le risque de conception en fonction du nombre de jours suivant le traitement.")%>%
  kable_styling()
HR et IC95 d’un traitement à la prostaglandine sur le risque de conception en fonction du nombre de jours suivant le traitement.
contrast HR lowCI hiCI
4 (0-5 days 1) - (0-5 days 0) 297.97 54.25 1636.51
8 (5-26 days 1) - (5-26 days 0) 9.13 3.14 26.53
13 >26 days 1 - >26 days 0 0.75 0.50 1.12

Réponse: L’injection de prostaglandines a donc un effet important sur le hasard de conception dans les 5 jours suivant l’injection (HR: 297.97; IC95: 54.25, 1636.51), puis cet effet est maintenu, mais moindre entre 5-26 jours (HR: 9.13; IC95: 3.14, 26.53) et, finalement, il n’y a plus d’effet après 26 jours (HR: 0.75; IC95: 0.50, 1.12).

1.4. Vérifiez que la linéarité de la relation est bien respectée pour la variable lact.
Réponse: On peut s’y prendre de 2 manières:
1) ajout de termes polynomiaux;
2) graphiques résiduels de Martingdale (d’un modèle sans le prédicteur lact) par la variable lact.

#Créer les termes polynomiaux
pgtrial$lact_ct <- pgtrial$lact-1
pgtrial$lact_ct_sq <- (pgtrial$lact-1)*(pgtrial$lact-1)
pgtrial$lact_ct_cu <- (pgtrial$lact-1)*(pgtrial$lact-1)*(pgtrial$lact-1)

#Le modèle avec le terme au carré
PH_fit_pg_sq <- coxph(Surv(dar, preg) ~ tx + lact_ct + lact_ct_sq + thin + herd, data=pgtrial)
library(survminer)
ggforest(PH_fit_pg_sq)

#Le modèle avec le terme au carré et celui au cube
PH_fit_pg_cu <- coxph(Surv(dar, preg) ~ tx + lact_ct + lact_ct_sq +lact_ct_cu + thin + herd, data=pgtrial)
ggforest(PH_fit_pg_cu)

Avec les termes polynomiaux: lact au carré est significatif (P = 0.03), cela indique donc une relation curvilinéaire. lact au cube n’est pas significatif (P=0.51), l’ajout de points d’inflexion n’est donc pas nécessaire. Nous pourrions donc utiliser \(lact\) et \(lact^2\) afin de correctement modéliser la relation entre lactation et temps jusqu’à la conception.

Avec le graphique des résiduels de Martingdale par la variable lact on observera encore cette relation curvilinéaire:

#Faire rouler le modèle sans le prédicteur continu lact
PH_fit_pg_WO_lact <- coxph(Surv(dar, preg) ~  tx + thin + herd, data=pgtrial)

#Ajouter les résiduels de Martingale dans mon jeu de données
pgtrial$res <- resid(PH_fit_pg_WO_lact) 

library(ggplot2)
ggplot(data=pgtrial, mapping=aes(x=lact, y=res))+
  geom_point() +  #Je demande d'ajouter le nuage de points (un 'scatterplot')
  geom_smooth(method="loess", span=2)+ #Je demande d'ajouter la courbe lissée de type loess. 
  theme_bw()
**Figure.** Graphique des résiduel de Martingdale en fonction de la parité.

Figure. Graphique des résiduel de Martingdale en fonction de la parité.

  1. Vos évaluations préliminaires vous ont permis de conclure que l’effet du traitement change dans le temps et que la relation entre lact et H(t) est une courbe. Vous décidez donc du modèle suivant:

\(Ln H(t) = ln H_0(t) + β_1*tx + β_2*tx*time + β_3*(lact-1) + β_4*(lact-1)^2 + β_5*thin + β_6*herd\)

Où time est une variable catégorique ≤5 jours vs. >5 jours.

2.1. Comment change le risque de conception dans les 5 jours suivant le traitement lorsque les prostaglandines sont utilisées plutôt qu’un placebo? Et après 5 jours?

#Créer ma variable temps
pgtrial$t5 <- cut(pgtrial$dar, breaks = c(0, 5, Inf),labels = c("0-5 days",  ">5 days"))

#Créer mes variables lact centrées et au carré
pgtrial$lact_ct <- pgtrial$lact-1
pgtrial$lact_ct_sq <- (pgtrial$lact-1)*(pgtrial$lact-1)

#Le modèle de Cox
library(survival)
PH_fit_pg_final <- coxph(Surv(dar, preg) ~  tx*t5 - t5 + lact_ct + lact_ct_sq + thin + herd, data=pgtrial)

library(emmeans)
#Je génère ensuite l'objet contrast à partir de mon modèle
contrast <- emmeans(PH_fit_pg_final, c("tx", "t5")) 

#Je demande les comparaisons pairées, je voulais voir Tx=1 vs Tx=0, j'ai donc du utilisé reverse=TRUE. Puis j'ai ajouté les IC95 avec confint
result <- confint(pairs(contrast, reverse = TRUE))

#Je retravaille mes résultats pour la présentation. D'abord en les mettant à l'exposant pour avoir des HR, puis en arrondissant.
result$HR <- round(exp(result$estimate), digits=2)
result$lowCI <- round(exp(result$asymp.LCL), digits=2)
result$hiCI <- round(exp(result$asymp.UCL), digits=2)

#Je ne conserve que les rangée (2 et 5) et les colonnes (1, 7, 8, 9) qui m'intéressent
result2 <- result[c(2, 5),c(1, 7, 8, 9)]

library(knitr)
library(kableExtra)
kable (result2, caption="HR et IC95 d'un traitement à la prostaglandine sur le risque de conception en fonction du nombre de jours suivant le traitement.")%>%
  kable_styling()
HR et IC95 d’un traitement à la prostaglandine sur le risque de conception en fonction du nombre de jours suivant le traitement.
contrast HR lowCI hiCI
2 (0-5 days 1) - (0-5 days 0) 226.96 49.77 1035.09
5 >5 days 1 - >5 days 0 0.84 0.59 1.20

2.2. En supposant qu’une vache resterait dans un troupeau jusqu’à 500 jours suivant le traitement avant d’être réformée, évaluez l’effet qu’aurait pu avoir une censure informative.

#Je dois d'abord créer une nouvelle variable DAR qui prendrait la valeur 500 pour les vaches censurées
pgtrial$dar2 <- ifelse(pgtrial$preg==1, pgtrial$dar, 500)
#Et une variable alternative preg où toutes les vaches sont gestantes à la fin
pgtrial$preg2 <- 1

#Ensuite, je peux faire 2 modèles de Cox en utilisant une ou l'autre de ces nouvelles variables
library(survival)
PH_fit_pg_cens_info_n <- coxph(Surv(dar2, preg) ~  tx*t5 - t5 + lact_ct + lact_ct_sq + thin + herd, data=pgtrial)
PH_fit_pg_cens_info_p <- coxph(Surv(dar2, preg2) ~  tx*t5 - t5 + lact_ct + lact_ct_sq + thin + herd, data=pgtrial)

Si on voulait plus particulièrement visualiser les effets pour le tx (et son interaction):

library(emmeans)
#Je génère d'abord l'objet contrast à partir de mon modèle
contrast_final <- emmeans(PH_fit_pg_final, c("tx", "t5")) 
contrast_censp <- emmeans(PH_fit_pg_cens_info_n, c("tx", "t5"))
contrast_censn <- emmeans(PH_fit_pg_cens_info_p, c("tx", "t5"))

#Je demande les comparaisons pairées, je voulais voir Tx=1 vs Tx=0, j'ai donc du utilisé reverse=TRUE. Puis j'ai ajouté les IC95 avec confint
result_final <- confint(pairs(contrast_final, reverse = TRUE))
result_censn <- confint(pairs(contrast_censn, reverse = TRUE))
result_censp <- confint(pairs(contrast_censp, reverse = TRUE))

#Je retravaille mes résultats pour la présentation. D'abord en les mettant à l'exposant pour avoir des HR, puis en arrondissant.
result_final$HR <- round(exp(result_final$estimate), digits=2)
result_final$lowCI <- round(exp(result_final$asymp.LCL), digits=2)
result_final$hiCI <- round(exp(result_final$asymp.UCL), digits=2)

result_censn$HR <- round(exp(result_censn$estimate), digits=2)
result_censn$lowCI <- round(exp(result_censn$asymp.LCL), digits=2)
result_censn$hiCI <- round(exp(result_censn$asymp.UCL), digits=2)

result_censp$HR <- round(exp(result_censp$estimate), digits=2)
result_censp$lowCI <- round(exp(result_censp$asymp.LCL), digits=2)
result_censp$hiCI <- round(exp(result_censp$asymp.UCL), digits=2)

#Je ne conserve que les rangée (2 et 5) et les colonnes (1, 7, 8, 9) qui m'intéressent
result_fin2 <- result_final[c(2,5),c(1, 7, 8, 9)]
result_censn2 <- result_censn[c(2,5),c(1, 7, 8, 9)]
result_censp2 <- result_censp[c(2,5),c(1, 7, 8, 9)]

library(knitr)
library(kableExtra)
kable (result_fin2, caption="Modèle final.")%>%
  kable_styling()
Modèle final.
contrast HR lowCI hiCI
2 (0-5 days 1) - (0-5 days 0) 226.96 49.77 1035.09
5 >5 days 1 - >5 days 0 0.84 0.59 1.20 
kable (result_censn2, caption="Modèle avec vaches censurées qui survivent jusqu'à 500 jours.")%>%
  kable_styling()
Modèle avec vaches censurées qui survivent jusqu’à 500 jours.
contrast HR lowCI hiCI
2 (0-5 days 1) - (0-5 days 0) 5.69 3.48 9.32
5 >5 days 1 - >5 days 0 0.85 0.61 1.16 
kable (result_censp2, caption="Modèle avec vaches censurées qui deviennent gestante au moment de la censure # v.")%>%
  kable_styling()
Modèle avec vaches censurées qui deviennent gestante au moment de la censure # v.
contrast HR lowCI hiCI
2 (0-5 days 1) - (0-5 days 0) 7.60 4.52 12.78
5 >5 days 1 - >5 days 0 0.81 0.57 1.15

On voit que les conclusions restent les mêmes (effet du tx entre 0-5 jours, mais pas d’effet > 5 jours). Par contre, l’effet serait moindre (HR de 6 à 7 vs. HR de 226) si la censure était informative.

2.3. Quelles sont les observations avec les résiduels les plus larges? Ont-elles quelquechose en commun?

#Je peux ajouter les résiduels de déviance à ma table
pgtrial$resid_dev <- resid(PH_fit_pg_final, type="deviance")

library(ggplot2)
library(ggrepel)
ggplot(data=pgtrial, mapping=aes(x=dar, y=resid_dev)) +
          geom_point() +
          theme_bw() +
  geom_text_repel(aes(label = cow))
**Figure.** Résiduels de déviance en fonction du temps.

Figure. Résiduels de déviance en fonction du temps.

On note que les vaches 78 et 1 on des résiduels assez larges (i.e. > 3.0); les vaches 196 et 208 ont aussi des résiduels assez larges (i.e. entre 2.5 et 3.0). La vache 189 a, elle aussi, un résiduel assez large mais négatif. Évidemment, les résiduels positifs les plus larges sont des vaches qui ont conçu très rapidement (1 jour) suite au traitement (toutes placebo). Les vaches avec les résiduels négatifs les plus larges sont celles qui ont de très long suivi sans conception (i.e. DAR large et PREG=0). Il ne semble pas y avoir de patron particulier pour ces vaches (lorsqu’on inspecte les tables directement:

#En filtrant la table pour ne conserver que les résiduels standardisés larges
res_large <- subset(pgtrial, (resid_dev >=2.5 | resid_dev<=-2.5))

kable (res_large, caption="Observations avec les résiduels les plus larges.")%>%
  kable_styling()
Observations avec les résiduels les plus larges.
herd cow tx lact thin dar preg t_cat lact_ct lact_ct_sq lact_ct_cu res t5 dar2 preg2 resid_dev
1 1 1 0 1 0 1 1 0-5 days 0 0 0 0.9917920 0-5 days 1 1 3.731375
74 2 78 0 2 1 1 1 0-5 days 1 1 1 0.9947488 0-5 days 1 1 3.858177
185 2 189 0 1 0 346 0 >26 days 0 0 0 -2.3808125 >5 days 500 1 -2.519159
192 3 196 0 1 0 3 1 0-5 days 0 0 0 0.9183528 0-5 days 3 1 2.982147
204 3 208 0 2 1 5 1 0-5 days 1 1 1 0.8671546 0-5 days 5 1 2.564270

2.4. Quelles sont les observations les plus influentes sur les coefficients \(tx\) et \(tx*time\)? Ont-elles quelquechose en commun?

#Créer les résiduels de déviance dans une table
y <- data.frame(resid(PH_fit_pg_final, type="score"))

#Joindre ces éléments dans ma table initiale
#Renommer les variables
library(data.table)
setnames(y, old = c('tx','lact_ct', 'lact_ct_sq', 'thin1', 'herd2', 'herd3', 'tx.t5.5.days'), new = c('score_tx','score_lact_ct', 'score_lact_ct_sq','score_thin', 'score_herd2', 'score_herd3', 'score_time_tx_inter'))

#Combiner les tables
a <- cbind(pgtrial, y) 

#Visualiser résiduels de score de tx en fonction du temps
library(ggplot2)
library(ggrepel)
ggplot(data=a, mapping=aes(x=dar, y=score_tx)) +
          geom_point() +
          theme_bw() +
          geom_text_repel(aes(label = cow))
**Figure.** Résiduels de score de la variable tx en fonction du temps.

Figure. Résiduels de score de la variable tx en fonction du temps.

Pour ce coefficient, les vaches 76, 184, 187, 188 et possiblement 189 et 323 semblent être des observations influentes (i.e. elles ont beaucoup d’impact sur les estimés de ce coefficient).

#Visualiser résiduels de score de tx en fonction du temps
library(ggplot2)
library(ggrepel)
ggplot(data=a, mapping=aes(x=dar, y=score_time_tx_inter)) +
          geom_point() +
          theme_bw() +
          geom_text_repel(aes(label = cow))
**Figure.** Résiduels de score de l'interaction tx par t5 (temps catégorique) en fonction du temps.

Figure. Résiduels de score de l’interaction tx par t5 (temps catégorique) en fonction du temps.

Ces ont les mêmes vaches qui sont influentes pour le coefficient de l’interaction. Ce sont toutes des vaches avec un nombre de jours de suivi élevé, la plupart (5/6) sont des observations censurées.

  1. Peng, R. D., F. Dominici, and S. L. Zeger. 2006. Reproducible epidemiologic research. Am J Epidemiol:783-789.↩︎

  2. Noble, W. S. 2009. A quick guide to organizing computational biology projects. PLoS computational biology:e1000424.↩︎

  3. Sandve, G. K., A. Nekrutenko, J. Taylor, and E. Hovig. 2013. Ten simple rules for reproducible computational research. PLoS computational biology:e1003285.↩︎

  4. Wilson, G., D. A. Aruliah, C. T. Brown, N. P. Chue Hong, M. Davis, R. T. Guy, S. H. Haddock, K. D. Huff, I. M. Mitchell, M. D. Plumbley, B. Waugh, E. P. White, and P. Wilson. 2014. Best practices for scientific computing. PLoS biology:e1001745.↩︎

  5. Recommendations for presenting analyses of effect modification and interaction. M. J. Knol and T. J. VanderWeele, Int J Epidemiol 2012 Vol. 41 Issue 2 Pages 514-20↩︎

  6. Recommendations for presenting analyses of effect modification and interaction. M. J. Knol and T. J. VanderWeele, Int J Epidemiol 2012 Vol. 41 Issue 2 Pages 514-20↩︎

  7. Barros, A. J. D. and V. N. Hirakata. 2003. Alternatives for logistic regression in cross-sectional studies: an empirical comparison of models that directly estimate the prevalence ratio. BMC Med Res Methodol.↩︎